Kuinka saada lähettäjän sähköpostiosoite yhdestä tai useammasta sähköpostista Outlookissa?
Oletko koskaan yrittänyt poimia sähköpostiosoitteen yhden tai useamman vastaanotetun sähköpostin Lähettäjä-kentästä Outlookissa? Tässä artikkelissa on VBA-koodi, joka auttaa sinua hoitamaan tämän tehtävän.
Hanki lähettäjän sähköpostiosoite yhdestä tai useammasta sähköpostista Outlookissa
Suorita seuraava VBA-koodi poimiaksesi sähköpostiosoitteen yhden tai useamman vastaanotetun sähköpostin Lähettäjä-kentästä Outlookissa.
1. Avaa sähköpostikansio, valitse sähköpostiviesti, josta haluat saada lähettäjän sähköpostiosoitteen. paina muut + F11 avaimet avaamaan Microsoft Visual Basic for Applications ikkunassa.
Vinkkejä: Jos haluat valita useita sähköposteja, pidä Ctrl näppäintä ja valitse sitten sähköpostit yksitellen.
2. Vuonna Microsoft Visual Basic for Applications -ikkunassa liite > Moduulit, kopioi sitten seuraava VBA-koodi Moduuli (koodi) -ikkunaan.
VBA-koodi: pura lähettäjän sähköpostiosoite yhdestä tai useammasta sähköpostista Outlookissa
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. napsauttaa Työkalut > Viitteet, tarkista sitten Microsoft Scripting Runtime laatikko Referenssit – Project1 valintaikkuna.
4. paina F5 avain koodin suorittamiseen. Sitten eräs Kutools Outlookille valintaikkuna avautuu, ja siinä näkyvät kaikki valittujen sähköpostien lähettäjien sähköpostiosoitteet.
Vinkkejä:
5. Kun olet napsauttanut Kyllä painike, a Selaa kansioon valintaikkuna avautuu. Valitse kansio, johon haluat tallentaa tiedoston, ja napsauta OK painiketta.
6. Lopuksi a Kutools Outlookille näyttöön tulee valintaikkuna, joka kertoo viedyn tiedoston polun. Klikkaus OK sulkea se.
7. Siirry kansioon, johon viety tiedosto on tallennettu, ja avaa .txt-tiedosto nimeltä Osoite nähdäksesi valittujen sähköpostien lähettäjän sähköpostiosoitteet.
Parhaat toimiston tuottavuustyökalut
Breaking News: Kutools for Outlook julkaisee ilmaisen version!
Koe täysin uusi Kutools for Outlook ILMAINEN versio, jossa on yli 70 uskomatonta ominaisuutta, sinun käytössäsi IKUISESTI! Lataa nyt napsauttamalla!
📧 Sähköpostiautomaatio: Automaattinen vastaus (saatavilla POP:lle ja IMAP:lle) / Ajoita sähköpostien lähettäminen / Automaattinen CC/BCC sääntöjen mukaan lähetettäessä sähköpostia / Automaattinen edelleenlähetys (lisäsäännöt) / Automaattinen tervehdys / Jaa usean vastaanottajan sähköpostit automaattisesti yksittäisiksi viesteiksi ...
📨 Sähköposti Management: Muista sähköpostit / Estä huijaussähköpostit aiheiden ja muiden taholta / Poista päällekkäiset sähköpostit / Tarkennettu Haku / Yhdistä kansiot ...
📁 Liitteet Pro: Erätallennus / Erä Irrota / Eräpakkaus / Automaattinen tallennus / Automaattinen irrotus / Automaattinen pakkaus ...
🌟 Interface Magic: 😊Lisää kauniita ja siistejä emojia / Muistuttaa sinua tärkeistä sähköpostiviesteistä / Minimoi Outlook sulkemisen sijaan ...
???? Yhden napsautuksen Wonders: Vastaa kaikkiin liitteillä / Tietojenkalastelun vastaiset sähköpostit / 🕘Näytä lähettäjän aikavyöhyke ...
👩🏼🤝👩🏻 Yhteystiedot ja kalenteri: Erä Lisää yhteystietoja valituista sähköpostiviesteistä / Jaa yhteysryhmä yksittäisiin ryhmiin / Poista syntymäpäivämuistutukset ...
