Outlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails

Home-›Foren-›Outlook-›Outlook VBA-›Outlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails

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
        Teilnehmer

          @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
          Christophe Heuschen
          Teilnehmer

            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.

          -