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

Outlookで電子メールを作成するときに、すべての受信者の名前をメッセージ本文に挿入する必要がある場合があります。もちろん、名前をXNUMXつずつコピーして本文に貼り付けることもできます。ただし、何十もの受信者名を貼り付ける必要がある場合は、非常に面倒です。この記事では、Outlookでこのジョブを解決する簡単な方法について説明します。

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

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

次のVBAコードは、[宛先]フィールドのすべての受信者名をメッセージ本文に挿入するのに役立ちます。次のようにしてください。

1。 Outlookを起動し、 Alt + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

2に設定します。 OK をクリックします。 インセット > モジュール、次のコードをに貼り付けます モジュール 窓。

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 ウィンドウ、クリック ツール > 参考文献 参考資料-Project1 ダイアログボックスをクリックし、チェックします MicrosoftWordオブジェクトライブラリ オプションから 利用可能な参考文献 リストボックス、スクリーンショットを参照：