Comment obtenir l'adresse e-mail de l'expéditeur d'un ou plusieurs e-mails dans Outlook ?
Avez-vous déjà essayé d'extraire l'adresse e-mail du champ "De" d'un ou plusieurs e-mails reçus dans Outlook ? Cet article fournit un code VBA pour vous aider à accomplir cette tâche.
Obtenir l'adresse e-mail de l'expéditeur d'un ou plusieurs e-mails dans Outlook
Veuillez exécuter le code VBA suivant pour extraire l'adresse e-mail du champ "De" d'un ou plusieurs e-mails reçus dans Outlook.
1. Ouvrez un dossier d'e-mails, sélectionnez un message électronique dont vous souhaitez obtenir l'adresse e-mail de l'expéditeur. Appuyez sur les touches Alt + F11 pour ouvrir la fenêtre Microsoft Visual Basic for Applications.
Remarque : Pour sélectionner plusieurs e-mails, maintenez la touche Ctrl enfoncée, puis sélectionnez les e-mails un par un.
2. Dans la fenêtre Microsoft Visual Basic for Applications, cliquez sur Insérer > Module, puis copiez le code VBA suivant dans la fenêtre Module (code).
Code VBA : extraire l'adresse e-mail de l'expéditeur d'un ou plusieurs e-mails dans 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. Cliquez sur Outils > Références, puis cochez la case Microsoft Scripting Runtime dans la boîte de dialogue Références – Projet1.
4. Appuyez sur la touche F5 pour exécuter le code. Ensuite, une boîte de dialogue Kutools for Outlook apparaît, listant toutes les adresses e-mail des expéditeurs des e-mails sélectionnés.
Remarque :
5. Après avoir cliqué sur le bouton Oui, une boîte de dialogue Parcourir le dossier apparaît. Veuillez choisir un dossier pour enregistrer le fichier et cliquez sur le bouton OK.
6. Enfin, une boîte de dialogue Kutools for Outlook s'affichera, indiquant le chemin du fichier exporté. Cliquez sur OK pour la fermer.
7. Allez dans le dossier où le fichier exporté est enregistré et ouvrez le fichier .txt nommé Adresse pour voir les adresses e-mail des expéditeurs des e-mails sélectionnés.
Meilleurs outils de productivité pour Office
Dernière nouvelle : Kutools pour Outlook lance une version gratuite !
Découvrez le tout nouveau Kutools pour Outlook avec plus de100 fonctionnalités incroyables ! Cliquez pour télécharger dès maintenant !
📧 Automatisation des emails : Réponse automatique (disponible pour POP et IMAP) / Programmation de l’envoi des emails / CC/BCC automatique selon des règles lors de l’envoi / Transfert automatique (Règle avancée) / Ajout automatique de la salutation / Fractionnement automatique des emails multi-destinataires en messages individuels...
📨 Gestion des emails : Rappeler les emails / Bloquer les emails frauduleux par sujet et autres critères / Supprimer les emails en double / Recherche Avancée / Organiser les dossiers...
📁 Pièces jointes Pro:Enregistrer par lot / Détachement par lot / Compression par lot / Enregistrer automatiquement/ Détachement automatique/Compression automatique...
🌟 Magie de l’interface : 😊Davantage d’emojis beaux et sympas / Recevez une alerte en cas d’email important / Réduisez Outlook au lieu de le fermer...
👍 Fonctions en un clic : Répondre à tous avec pièces jointes / Anti-phishing emails / 🕘Afficher le fuseau horaire de l’expéditeur...
👩🏼🤝👩🏻 Contacts & Calendrier: Ajouter des contacts en lot à partir des emails sélectionnés / Diviser un groupe de contacts en groupes individuels / Supprimer le rappel d’anniversaire...
Utilisez Kutools dans la langue de votre choix– prend en charge l’anglais, l’espagnol, l’allemand, le français, le chinois, et plus de40 autres langues !
