如何在 Outlook 中將所有收件人的姓名插入郵件內文？

有時在 Outlook 中撰寫電子郵件時，您可能需要將所有收件人的姓名插入郵件內文中。雖然可以逐一複製並貼上這些姓名，但當收件人多達數十位時，這種做法便顯得格外繁瑣。本文將為您介紹一種簡單有效的方法，讓您在 Outlook 中輕鬆完成這項任務。

使用 Outlook 中的 VBA 程式碼將所有收件人姓名插入郵件內文

---

使用 Outlook 中的 VBA 程式碼將所有收件人姓名插入郵件內文

下列 VBA 程式碼可協助您將「收件者」欄位中的所有收件人姓名插入郵件內文，請依照以下步驟操作：

1. 啟動 Outlook，然後按住 ALT + F11 鍵，即可開啟 Microsoft Visual Basic for Applications 視窗。

2. 點選插入＞ 模組，並將下列程式碼貼到模組視窗中。

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 for Applications 視窗中，點選工具> 參考項目 以開啟 參考項目 - Project 1 對話方塊，並從 Microsoft Word 物件庫清單中勾選可用參考項目，如截圖所示：

4. 接著點選確定關閉對話方塊。現在，您應已將此程式碼新增至快速存取工具列。

5. 點選新建郵件建立新郵件，在郵件視窗中，點選自訂快速存取工具列圖示，再選擇其他命令，如截圖所示：

6. 在 Outlook 選項對話方塊中：

（1.） 從巨集下拉清單中選取從下列位置選擇命令；

（2.） 接著選擇您剛才插入的 VBA 程式碼名稱；

（3.） 點選新增按鈕，即可將該程式碼加入自訂快速存取工具列清單方塊中。

7. 此時，巨集圖示會顯示於快速存取工具列中，如下圖所示：

8. 現在，當您點選該巨集圖示時，「收件者」欄位中的收件人姓名就會插入郵件內文，如下圖所示：