Как да вмъкна всички имена на получатели в тялото на имейла в Outlook?

Автор: Xiaoyang Последна промяна: 2018-04-10

Понякога може да се наложи да вмъкнете имената на всички получатели в тялото на съобщението, когато пишете имейл в Outlook. Разбира се, можете да копирате и поставите имената в тялото едно по едно. Но е много досадно, ако има десетки имена на получатели, които трябва да бъдат поставени. В тази статия ще говоря за лесен начин за решаване на тази задача в Outlook.

Вмъкнете всички имена на получатели в тялото на имейл с VBA код в Outlook

Вмъкнете всички имена на получатели в тялото на имейл с VBA код в Outlook

Следният VBA код може да ви помогне да вмъкнете всички имена на получатели от полето До в тялото на съобщението, моля, направете следното:

1. Стартирайте Outlook и след това задръжте ALT + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

2. Щракнете Поставете > Модулии поставете следния код в Модули Window.

VBA код: Вмъкнете имена на получатели в тялото на съобщението:

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. И тогава все още в Microsoft Visual Basic за приложения прозорец, кликнете Инструменти > Препратки за да отидете на Референции-Проект1 диалогов прозорец и проверете Библиотека с обекти на Microsoft Word опция от Налични препратки списъчно поле, вижте екранна снимка:

4, След това кликнете OK за да затворите диалоговия прозорец, сега трябва да добавите този код към Лента с инструменти за бърз достъп.

5. Създайте ново съобщение, като щракнете нов имейл, В Събщение прозорец, кликнете Персонализирайте лентата с инструменти за бърз достъп и изберете Още команди, вижте екранна снимка:

6. В Outlook Options диалогов прозорец:

(1.) Изберете Макроси от Изберете команди от падащ списък;

(2.) И след това изберете кодовото име на VBA, което сте вмъкнали току-що;

(3.) Щракнете Добави бутон, за да добавите кода в Персонализирайте лентата с инструменти за бърз достъп списъчно поле.

7. След това се показва макро икона в Лента с инструменти за бърз достъп както е показана следната екранна снимка:

8. Сега, когато щракнете върху иконата на макрос, имената на получателите от полето До ще бъдат вмъкнати в тялото на съобщението, както е показано на следната екранна снимка: