Outlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails

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 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
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.