Wie kann man die Absender-E-Mail-Adresse einer oder mehrerer E-Mails in Outlook ermitteln?

AutorSiluvia Änderungsdatum2024-09-13

Haben Sie schon einmal versucht, die E-Mail-Adresse aus dem „Von“-Feld einer oder mehrerer empfangener Nachrichten in Outlook zu extrahieren? Dieser Artikel liefert Ihnen einen VBA-Code, der diese Aufgabe für Sie erledigt.

Abrufen der Absender-E-Mail-Adresse einer oder mehrerer E-Mails in Outlook

Führen Sie den folgenden VBA-Code aus, um die E-Mail-Adresse aus dem „Von“-Feld einer oder mehrerer empfangener Outlook-E-Mails zu extrahieren.

1. Öffnen Sie einen E-Mail-Ordner und wählen Sie die E-Mail-Nachricht aus, von der Sie die Absender-E-Mail-Adresse abrufen möchten. Drücken Sie die Tasten Alt+F11, um das Fenster Microsoft Visual Basic for Applications zu öffnen.

Tipp: Um mehrere E-Mails auszuwählen, halten Sie die Strg-Taste gedrückt und klicken Sie nacheinander auf die gewünschten E-Mails.

2. Klicken Sie im Fenster Microsoft Visual Basic for Applications auf Einfügen > Modul, und fügen Sie dann den folgenden VBA-Code in das Modul-(Code-)Fenster ein.

Schritte zum Abrufen der Absender-E-Mail-Adresse aus einer oder mehreren E-Mails in Outlook

VBA-Code: Extrahieren der Absender-E-Mail-Adresse einer oder mehrerer E-Mails in Outlook

Sub GetSmtpAddressOfSelectionEmail()
  Dim xExplorer As Explorer
  Dim xSelection As Selection
  Dim xItem As Object
  Dim xMail As MailItem
  Dim xAddress As String
  Dim xFldObj As Object
  Dim FilePath As String
  Dim xFSO As Scripting.FileSystemObject
  On Error Resume Next
  Set xExplorer = Application.ActiveExplorer
  Set xSelection = xExplorer.Selection
  For Each xItem In xSelection
    If xItem.Class = olMail Then
      Set xMail = xItem
      xAddress = xAddress & VBA.vbCrLf & "  " & GetSmtpAddress(xMail)
    End If
  Next
  If MsgBox("Sender SMTP Address is: " & xAddress & vbCrLf & vbCrLf & "Do you want to export the address list to a txt file? ", vbYesNo, "Kutools for Outlook") = vbYes Then
    Set xFldObj = CreateObject("Shell.Application").BrowseforFolder(0, "Select a Folder", 0, 16)
    Set xFSO = New Scripting.FileSystemObject
    If xFldObj Is Nothing Then Exit Sub
    FilePath = xFldObj.Items.Item.Path & "\Address.txt"
    Close #1
    Open FilePath For Output As #1
    Print #1, "Sender SMTP Address is: " & xAddress
    Close #1
    Set xFSO = Nothing
    Set xFldObj = Nothing
    MsgBox "Address list has been exported to：" & FilePath, vbOKOnly + vbInformation, "Kutools for Outlook"
  End If
End Sub
Function GetSmtpAddress(Mail As MailItem)
  Dim xNameSpace As Outlook.NameSpace
  Dim xEntryID As String
  Dim xAddressEntry As AddressEntry
  Dim PR_SENT_REPRESENTING_ENTRYID As String
  Dim PR_SMTP_ADDRESS As String
  Dim xExchangeUser As exchangeUser
  On Error Resume Next
  GetSmtpAddress = ""
  Set xNameSpace = Application.Session
  If Mail.sender.Type <> "EX" Then
    GetSmtpAddress = Mail.sender.Address
  Else
    PR_SENT_REPRESENTING_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x00410102"
    xEntryID = Mail.PropertyAccessor.BinaryToString(Mail.PropertyAccessor.GetProperty(PR_SENT_REPRESENTING_ENTRYID))
    Set xAddressEntry = xNameSpace.GetAddressEntryFromID(xEntryID)
    If xAddressEntry Is Nothing Then Exit Function
    If xAddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Or xAddressEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
      Set xExchangeUser = xAddressEntry.GetExchangeUser()
      If xExchangeUser Is Nothing Then Exit Function
      GetSmtpAddress = xExchangeUser.PrimarySmtpAddress
    Else
      PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
      GetSmtpAddress = xAddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
    End If
  End If
End Function

3. Klicken Sie auf Extras > Verweise, und aktivieren Sie dann das Kontrollkästchen Microsoft Scripting Runtime im Dialogfeld Verweise – Projekt1.

4. Drücken Sie die Taste F5, um den Code auszuführen. Anschließend erscheint das Dialogfeld Kutools für Outlook, das die E-Mail-Adressen aller Absender der ausgewählten E-Mails auflistet.

Tipps:

Wenn Sie die Adressliste in eine TXT-Datei exportieren möchten, klicken Sie auf die Schaltfläche Ja.

Oder klicken Sie auf die Schaltfläche Nein, um den Vorgang zu beenden.

5. Nachdem Sie auf die Schaltfläche Ja geklickt haben, erscheint das Dialogfeld Ordner durchsuchen. Wählen Sie einen Ordner zum Speichern der Datei aus und klicken Sie auf die Schaltfläche OK.

6. Schließlich erscheint ein Dialogfeld Kutools für Outlook, das Ihnen den Pfad der exportierten Datei anzeigt. Klicken Sie auf OK, um es zu schließen.

7. Wechseln Sie in den Ordner, in dem die exportierte Datei gespeichert wurde, und öffnen Sie die .TXT-Datei mit dem Namen Address, um die Absender-E-Mail-Adresse der ausgewählten E-Mails einzusehen.

Beste Office-Produktivitätswerkzeuge

Erleben Sie das komplett neue Kutools für Outlook mit 100+ unglaublichen Funktionen!Jetzt zum Download klicken!

🤖KUTOOLS AI:Nutzt fortschrittliche KI-Technologie, um E-Mails mühelos zu verwalten – einschließlich Beantworten, Zusammenfassen, Optimieren, Erweitern, Übersetzen und Verfassen von E-Mails.

📧E-Mail-Automatisierung: Automatische Antworten (verfügbar für POP und IMAP) / E-Mails zeitgesteuert versenden / Beim Senden automatisch CC/BCC basierend auf Regeln hinzufügen / Automatische Weiterleitung (Erweiterte Regeln) / Automatische Grußformel einfügen / Mehrfachadressierte E-Mails automatisch in Einzelnachrichten aufteilen …

📨E-Mail-Verwaltung: E-Mails zurückrufen, Betrugs-E-Mails anhand von Betreffzeilen und weiteren Kriterien blockieren, doppelte E-Mails löschen, Erweiterte Suche, Ordner organisieren …

📁Anhänge Pro: Stapelweise speichern / Stapelweise lösen / Stapelweise komprimieren / Automatisch speichern / Automatisch abtrennen / Automatische Komprimierung …

🌟Oberflächenzauber:😊Noch mehr hübsche und coole Emojis/Benachrichtigung bei wichtigen eingehenden E-Mails/Outlook minimieren statt schließen...

👍Ein-Klick-Wunder: Allen mit Anhängen antworten / Anti-Phishing-E-Mails / 🕘Aktuelle Uhrzeit der Absender-Zeitzone anzeigen...

👩🏼‍🤝‍👩🏻Kontakte & Kalender:Stapelweise Kontakte aus ausgewählten E-Mails hinzufügen/Eine Kontaktgruppe in einzelne Kontakte aufteilen/Geburtstagserinnerung entfernen...

Nutzen Sie Kutools in Ihrer bevorzugten Sprache – mit Unterstützung für Englisch, Spanisch, Deutsch, Französisch, Chinesisch und über 40 weitere Sprachen!

Kutools für Outlook mit nur einem Klick sofort freischalten! Warten Sie nicht – laden Sie jetzt herunter und steigern Sie Ihre Effizienz!

Funktionsliste von Kutools für Outlook Jetzt herunterladen Zum Kauf gehen

🚀 Ein-Klick-Download – Holen Sie sich alle Office-Add-Ins

Stark empfohlen: Kutools for Office (5-in-1)

Mit einem Klick fünf Installationsprogrammegleichzeitig herunterladen –Kutools für Excel, Outlook, Word, PowerPointund Office Tab Pro.Jetzt zum Download klicken!

✅Ein-Klick-Komfort: Laden Sie alle fünf Installationspakete mit nur einem Klick herunter.
🚀Bereit für jede Office-Aufgabe: Installieren Sie die Add-Ins, die Sie brauchen – genau dann, wenn Sie sie benötigen.
🧰Enthalten: Kutools für Excel / Kutools für Outlook / Kutools für Word / Office Tab Pro / Kutools for PowerPoint

Über das Paket ⬇ Das Paket herunterladen 💳 Das Paket kaufen