Outlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails

HomeForenOutlookOutlook VBAOutlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails

Dieses Thema enthält 3 Antworten und 3 Teilnehmer. Es wurde zuletzt aktualisiert von  Christophe Heuschen vor 5 Monate.

Ansicht von 4 Beiträgen - 1 bis 4 (von insgesamt 4)
  • Autor
    Beitrag
  • #51102

    Unbekannt
    Teilnehmer

    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.

    #186832

    Unbekannt
    Teilnehmer

    Vielen Dank! Das Makro ist sehr hilfreich!!!!

    #192561

    mfriedlein
    Mitglied

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

    #1019750

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

Ansicht von 4 Beiträgen - 1 bis 4 (von insgesamt 4)

Du musst angemeldet sein, um auf dieses Thema antworten zu können.