Hogyan illessze be az összes címzett nevét az Outlook e-mail törzsébe?

Előfordulhat, hogy e-mail írásakor az Outlook programban be kell illesztenie az összes címzett nevét az üzenet törzsébe. Természetesen egyesével másolhatja és beillesztheti a neveket a törzsbe. De nagyon unalmas, ha több tucat címzett nevét kell beilleszteni. Ebben a cikkben a feladat egyszerű megoldásáról beszélek az Outlook programban.

Helyezze be az összes címzett nevét az Outlook VBA kóddal ellátott e-mail törzsébe

Helyezze be az összes címzett nevét az Outlook VBA kóddal ellátott e-mail törzsébe

A következő VBA-kód segíthet az összes címzett nevének beillesztésében a To mezőbe az üzenet törzsébe, kérjük, tegye a következőket:

1. Indítsa el az Outlook programot, majd tartsa lenyomva a ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Kattints betétlap > Modulok, és illessze be a következő kódot a Modulok Ablak.

VBA kód: Helyezze be a címzettek nevét az üzenet törzsébe:

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. És akkor még mindig a Microsoft Visual Basic for Applications ablakban kattintson Eszközök > Referenciák menni Referenciák-Projekt1 párbeszédpanelt, és ellenőrizze Microsoft Word objektumkönyvtár lehetőség a Elérhető referenciák lista mező, lásd a képernyőképet:

4. Ezután kattintson OK a párbeszédablak bezárásához most hozzá kell adnia ezt a kódot a Gyorselérési eszköztár.

5. Kattintson az új üzenet létrehozására új Email, A Üzenet ablakban kattintson A Gyorselérés eszköztár testreszabása ikonra, és válasszuk a lehetőséget További parancsok, lásd a képernyőképet: