Outlook: Automatisches Auslesen der Absenderadresse aus mehreren markierten Mails

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