Home-›Foren-›Outlook-›Outlook VBA-›Outlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails
Verschlagwortet: Outlook VBA Emailbeantworten
- Dieses Thema hat 3 Antworten sowie 3 Stimmen und wurde zuletzt vor 22:20 um 24. November 2016 von Christophe Heuschen aktualisiert.
- AutorBeitrag
- 16. Februar 2010 um 14:33 #51102UnbekanntTeilnehmer
Hallo, Community,
ich hatte das Problem, sehr viele einzelne Mails von unterschiedlichen Absendern, mit dem gleichen Text beantworten zu müssen. Damit ich das nicht händisch machen musste, habe ich das unten angegebene Makro für Outlook geschrieben.
Es ermittelt aus den markierten Mails in einem Ordner die Absenderadressen und schreibt diese, mit ; getrennt, in den Text eines neuen Mails, das in den Entwürfen gespeichert wird.
Von dort kann man die Liste dann leicht ins An: oder Bcc: Feld kopieren. Das ginge natürlich auch automatisch, aber das ist sozusagen ein Sicherheitsnetz gegen unabsichtliches Spammen (einmal versehentlich auf \”Senden\” geklickt…).
Garantien übernehme ich keine, es gibt auch keine besondere Absicherung im Makro. Es gibt nur eine Warnung, wenn mehr als 100 Mails markiert sind bzw. wird der Fehler, dass es keine Sender-Adresse gibt (kann in speziellen Fällen vorkommen) einfach ignoriert.
Wichtig: Eventuell verlangt die Sicherheitseinstellung von Outlook, dass man Makros erst aktivieren muss bzw. diesem den Zugriff auf das Adressbuch erlaubt.
Regards,
Kürbiskernöl
Sub MassAnswerToMails()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myMessage As MailItem
Dim strReceivers As String
Dim cntMails As Integer
Dim myAnswer As Variant
Dim strQuestion As StringSet myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
If myOlSel.Count > 100 Then
strQuestion = \”Sie haben \” & myOlSel.Count & \” Objekte ausgewählt. Wollen Sie wirklich fortfahren?\”
myAnswer = MsgBox(strQuestion, vbYesNo + vbDefaultButton1, \”Achtung\”)
If myAnswer = vbNo Then
Exit Sub
End If
End If
For cntMails = 1 To myOlSel.Count
On Error Resume Next \’Falls es zB das Property in dem Objekt nicht korrekt gibt
strReceivers = strReceivers & myOlSel.Item(cntMails).SenderEmailAddress & \”; \”
On Error GoTo 0
Next cntMails
Set myMessage = myOlApp.CreateItem(olMailItem)
myMessage.Body = strReceivers
myMessage.Save
MsgBox \”Fertig! Leeres Mail mit allen Absenderadressen im Text in den Entwürfen gespeichert!\”End Sub
Noch ein paar Stichworte zu dem Thema: Mehrere Mails im gleichen Arbeitsschritt beantworten; Absenderadressen aus Mails auslesen.
30. Juni 2011 um 15:34 #186832UnbekanntTeilnehmerVielen Dank! Das Makro ist sehr hilfreich!!!!
7. März 2013 um 11:28 #192561mfriedleinTeilnehmer@Kürbiskernöl
Wow – super Sache und so einfach! Genial – das hat mir viel Zeit erspart. Kann ich mich dafür mit einem Glas Honig (selbst geimkert) revanchieren?
Außerdem würde mich interessieren, ob Sie auch auf Stundenbasis bei Bedarf angefordert werden können.24. November 2016 um 22:20 #1019750Christophe HeuschenTeilnehmerSub <span style=”color: #191919; font-family: Dosis, Helvetica, Arial, sans-serif; font-size: 14px;”>MassAnswerToMailsV</span>eraendert()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myMessage As MailItem
Dim strReceivers As String
Dim cntMails As Integer
Dim myAnswer As Variant
Dim strQuestion As String
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
If myOlSel.Count > 100 Then
strQuestion = “Sie haben ” & myOlSel.Count & ” Objekte ausgewählt. Wollen Sie wirklich fortfahren?”
myAnswer = MsgBox(strQuestion, vbYesNo + vbDefaultButton1, “Achtung”)
If myAnswer = vbNo Then
Exit Sub
End If
End If
For cntMails = 1 To myOlSel.Count
On Error Resume Next ‘Falls es zB das Property in dem Objekt nicht korrekt gibt
strReceivers = strReceivers & myOlSel.Item(cntMails).SenderEmailAddress & “; ”
On Error GoTo 0
‘Set myMessage = myOlApp.CreateItem(olMailItem) ‘erstellt eine neue Email
Set myMessage = myOlApp.CreateItemFromTemplate(“C:\dein Speicherort\Dateiname.oft”)
myMessage.SentOnBehalfOfName = “AbsenderMail@lol.de” ‘bitte ausfüllen
myMessage.To = strReceivers
‘myMessage.HTMLBody = “Hier dein Body da ich eine Vorlage nutze ist es aus :-)”
‘myMessage.Send ‘sendet eine Mail direkt raus
myMessage.Display ‘zeigt die Email an, du kannst jetzt entscheiden ob du sie löschst oder versendest
Next cntMails
MsgBox “Fertig!”
End Sub
Bitte füllt den Absender aus und den Speicherort wo eure Vorlage liegt ausfüllen.
Ich habe die obere Datei 1:1 übernommen und unten Kleinigkeiten geändert. Der Effekt ist, alle Markierten Emails erhalten auf Knopfdruck ein separate Antwort anhand einer Vorlage. Es ginge auch mit einem einfach Text aus der Makro. Ich denke jedoch das eine Vorlage hilfreicher ist. Da ich genau das suchte, gebe ich es so an Anderen weiter.
Bei Fragen lithedragon@yahoo.de
- AutorBeitrag