Przejdź do głównej zawartości

Jak uzyskać adres e-mail nadawcy z jednego lub więcej e-maili w Outlooku?

Czy kiedykolwiek próbowałeś wyodrębnić adres e-mail z pola "Od" jednego lub więcej otrzymanych wiadomości e-mail w Outlooku? Ten artykuł zawiera kod VBA, który pomoże Ci poradzić sobie z tym zadaniem.


Uzyskaj adres e-mail nadawcy z co najmniej jednego e-maila w programie Outlook

Uruchom następujący kod VBA, aby wyodrębnić adres e-mail z pola „Od” jednego lub więcej otrzymanych wiadomości e-mail w programie Outlook.

1. Otwórz folder e-mail, wybierz wiadomość e-mail, z której chcesz uzyskać adres e-mail nadawcy. wciśnij inny + F11 klawisze, aby otworzyć Microsoft Visual Basic for Applications okno.

Tips: Aby wybrać wiele e-maili, przytrzymaj Ctrl klucz, a następnie wybierz wiadomości e-mail jeden po drugim.

2. w Microsoft Visual Basic for Applications okno, kliknij wstawka > Moduł, a następnie skopiuj następujący kod VBA do okna modułu (kod).

Kod VBA: wyodrębnij adres e-mail nadawcy z jednego lub więcej e-maili w Outlooku

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. kliknij Tools > Referencje, a następnie sprawdź Środowisko wykonawcze skryptów firmy Microsoft Microsoft Okno w Referencje – Projekt1 okno dialogowe.

4. wciśnij F5 klucz do uruchomienia kodu. Następnie Kutools dla programu Outlook pojawi się okno dialogowe z listą wszystkich adresów e-mail nadawcy wybranych e-maili.

Tips:

Jeśli chcesz wyeksportować listę adresów do pliku txt, kliknij przycisk Tak przycisk.
Lub kliknij Nie przycisk, aby zakończyć proces.

5. Po kliknięciu przycisku Tak przycisk, a Przeglądaj w poszukiwaniu folderu pojawi się okno dialogowe. Wybierz folder, w którym chcesz zapisać plik i kliknij OK przycisk.

6. Wreszcie Kutools dla programu Outlook pojawi się okno dialogowe z informacją o ścieżce eksportowanego pliku. Kliknij OK zamknąć to.

7. Przejdź do folderu, w którym zapisany jest eksportowany plik i otwórz plik .txt o nazwie Adres aby zobaczyć adresy e-mail nadawcy wybranych e-maili.


Najlepsze narzędzia biurowe

Kutools dla programu Outlook - Ponad 100 zaawansowanych funkcji, które usprawnią Twoje perspektywy

🤖 Asystent poczty AI: Natychmiastowe profesjonalne e-maile z magią AI — genialne odpowiedzi jednym kliknięciem, doskonały ton, biegła znajomość wielu języków. Zmień e-mailing bez wysiłku! ...

📧 Automatyzacja poczty e-mail: Poza biurem (dostępne dla POP i IMAP)  /  Zaplanuj wysyłanie wiadomości e-mail  /  Automatyczne CC/BCC według reguł podczas wysyłania wiadomości e-mail  /  Automatyczne przewijanie (Zasady zaawansowane)   /  Automatyczne dodawanie powitania   /  Automatycznie dziel wiadomości e-mail od wielu odbiorców na pojedyncze wiadomości ...

📨 Zarządzanie e-mail: Łatwe przywoływanie e-maili  /  Blokuj oszukańcze wiadomości e-mail według tematów i innych  /  Usuń zduplikowane wiadomości e-mail  /  Wiecej opcji  /  Konsoliduj foldery ...

📁 Załączniki ProZapisz zbiorczo  /  Odłącz partię  /  Kompresuj wsadowo  /  Automatyczne zapisywanie   /  Automatyczne odłączanie  /  Automatyczna kompresja ...

🌟 Magia interfejsu: 😊Więcej ładnych i fajnych emotikonów   /  Zwiększ produktywność programu Outlook dzięki widokom na kartach  /  Zminimalizuj program Outlook zamiast go zamykać ...

>> Cuda jednym kliknięciem: Odpowiedz wszystkim, dodając przychodzące załączniki  /   E-maile chroniące przed phishingiem  /  🕘Pokaż strefę czasową nadawcy ...

👩🏼‍🤝‍👩🏻 Kontakty i kalendarz: Grupowe dodawanie kontaktów z wybranych e-maili  /  Podziel grupę kontaktów na pojedyncze grupy  /  Usuń przypomnienia o urodzinach ...

O Cechy 100 Poczekaj na eksplorację! Kliknij tutaj, aby dowiedzieć się więcej.

 

 

Comments (0)
No ratings yet. Be the first to rate!
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations