Outlookでメール本文にすべての受信者名を挿入するにはどうすればよいですか？

Author: Xiaoyang Last Modified: 2025-05-23

場合によっては、Outlookでメールを作成する際に、メッセージ本文にすべての受信者の名前を挿入する必要があるかもしれません。もちろん、名前を一つずつコピーして本文に貼り付けることもできますが、数十人の受信者名を貼り付ける必要がある場合は非常に面倒です。この記事では、Outlookでこの作業を簡単に行う方法について説明します。

OutlookでVBAコードを使用してすべての受信者名をメール本文に挿入する

OutlookでVBAコードを使用してすべての受信者名をメール本文に挿入する

次のVBAコードを使用すると、「To」フィールドからすべての受信者名をメッセージ本文に挿入することができます。以下の手順を行ってください：

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ウィンドウで、「ツール」＞「参照設定」をクリックして「参照設定 - プロジェクト1」ダイアログボックスを開き、「利用可能な参照」リストボックスから「Microsoft Word Object Library」オプションをチェックしてください。スクリーンショットをご覧ください：