Comment insérer tous les noms de destinataires dans le corps de l'e-mail dans Outlook?

Parfois, vous devrez peut-être insérer les noms de tous les destinataires dans le corps du message lors de la rédaction d'un e-mail dans Outlook. Bien sûr, vous pouvez copier et coller les noms dans le corps un par un. Mais, il est très fastidieux si des dizaines de noms de destinataires doivent être collés. Cet article, je vais parler d'un moyen simple de résoudre ce travail dans Outlook.

Insérer tous les noms de destinataires dans le corps de l'e-mail avec le code VBA dans Outlook

Insérer tous les noms de destinataires dans le corps de l'e-mail avec le code VBA dans Outlook

Le code VBA suivant peut vous aider à insérer tous les noms de destinataires du champ À dans le corps du message, procédez comme suit:

1. Lancez Outlook, puis maintenez la touche ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2Cliquez sur insérer > Moduleet collez le code suivant dans le Module Fenêtre.

Code VBA: insérez les noms des destinataires dans le corps du message:

Sub InsertRecipientNamesToBody()
Dim xMailItem As Outlook.MailItem
Dim xRecipient As Outlook.Recipient
Dim xRecipAddress, xRecipNames, xRecipName, xFilterAddr As String
Dim xItems As Outlook.Items
Dim i As Integer
Dim xFoundContact As Outlook.ContactItem
Dim xDoc As Word.Document
On Error Resume Next
Set xMailItem = Outlook.ActiveInspector.CurrentItem
xMailItem.Recipients.ResolveAll
For Each xRecipient In xMailItem.Recipients
    xRecipAddress = xRecipient.Address
    Set xItems = Application.Session.GetDefaultFolder(olFolderContacts).Items
    For i = 1 To 3
        xFilterAddr = "[Email" & i & "Address] = " & xRecipAddress
        Set xFoundContact = xItems.Find(xFilterAddr)
        If Not (xFoundContact Is Nothing) Then
           xRecipNames = xRecipNames & xFoundContact.FullName & Chr(10)
           Exit For
        End If
    Next
    If (xFoundContact Is Nothing) Then
       xRecipName = Split(xRecipAddress, "@")(0)
       xRecipNames = xRecipNames & xRecipName & Chr(10)
    End If
Next
Set xDoc = xMailItem.GetInspector.WordEditor
xDoc.Content.InsertAfter xRecipNames
Set xMailItem = Nothing
Set xRecipient = Nothing
Set xItems = Nothing
Set xFoundContact = Nothing
End Sub

3. Et puis toujours dans le Microsoft Visual Basic pour applications fenêtre, cliquez sur Outils > Bibliographie pour aller à la Références-Projet1 boîte de dialogue et cochez Bibliothèque d'objets Microsoft Word Option de Références disponibles zone de liste, voir capture d'écran:

4. Puis clique OK pour fermer la boîte de dialogue, vous devez maintenant ajouter ce code au Barre d'outils d'accès rapide.

5. Créez un nouveau message en cliquant sur Nouveau Email, Dans le Message fenêtre, cliquez sur Personnaliser la barre d'outils Accès rapide icône et sélectionnez Plus de commandes, voir capture d'écran:

6. Dans le Options d'Outlook boite de dialogue:

(1.) Sélectionnez Macros du Choisissez les commandes de la liste déroulante;

(2.) Et puis choisissez le nom de code VBA que vous venez d'insérer;

(3.) Cliquez sur Ajouter pour ajouter le code dans le Personnaliser la barre d'outils Accès rapide zone de liste.

7. Et puis une icône de macro s'affiche dans le Barre d'outils d'accès rapide comme capture d'écran suivante:

8. Maintenant, lorsque vous cliquez sur l'icône de macro, les noms des destinataires du champ À seront insérés dans le corps du message comme illustré ci-dessous: