Outlook で受信者に応じて署名を自動的に切り替えるには？

Outlook には、既定で異なるメールアカウントから送信する際に署名を自動的に切り替える機能が備わっています。さらにここでは、「宛先」欄に入力された受信者に応じて、署名を自動的に変更する方法もご紹介します。

VBA コードで受信者に応じて署名を自動的に変更する

---

VBA コードで受信者に応じて署名を自動的に変更する

Outlook でメール送信時に、対応する受信者ごとに異なる署名を適用するには、以下の手順に従ってください。

1。まず、Outlook の自動署名添付機能を無効にする必要があります。「ファイル > オプション」をクリックして、「Outlook のオプション」ウィンドウを開きます。

2。「Outlook のオプション」ウィンドウで、左側のペインから「メール」を選択し、「メッセージ作成」セクション内の「署名」ボタンをクリックします。スクリーンショットをご参照ください：

3。「署名と定型文」ダイアログボックスで、「電子メール署名」タブ内の「既定の署名の選択」セクションに移動し、「メールアカウント」ドロップダウンリストからメールアカウントを選択します。その後、「新規メッセージ」および「返信/転送」ドロップダウンリストから「（なし）」を選択してください。すべてのアカウントが「（なし）」に設定されるまで、この操作を繰り返します。最後に、「OK」ボタンをクリックします。

注：この「署名と定型文」ダイアログボックスで、必要な署名をすぐに作成できます。

4。「OK」ボタンをクリックして、「Outlook のオプション」ウィンドウに戻ります。

5。「Alt+F11」キーを押すと、「Microsoft Visual Basic for Applications」ウィンドウが開きます。

6。「Microsoft Visual Basic for Applications」ウィンドウで、左側のペインにある「ThisOutlookSession」をダブルクリックしてコードウィンドウを開き、以下の VBA コードをそのウィンドウに貼り付けてください。スクリーンショットをご参照ください：

VBA コード：Outlook で受信者に応じて署名を自動的に変更する

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/08/01
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim xRecipient As Recipient
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO As Scripting.FileSystemObject
Dim xDoc As Document
Dim xFindStr As String
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
For Each xRecipient In xRecipients
    If xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        xRcpAddress = xRecipient.AddressEntry.Address
    End If
    Select Case xRcpAddress
        Case "Email Address 1"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "Email Address 2", "Email Address 3"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "Email Address 4"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xFindStr = "From: " & xMailItem.Recipients.Item(1).Name & " <" & xRcpAddress & ">"
If VBA.InStr(1, xMailItem.Body, xFindStr) <> 0 Then
    xDoc.Application.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    With xDoc.Application.Selection.Find
        .ClearFormatting
        .Text = xFindStr
        .Execute Forward:=True
    End With
    With xDoc.Application.Selection
        .MoveLeft wdCharacter, 2
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
Else
    With xDoc.Application.Selection
        .EndKey Unit:=wdStory, Extend:=wdMove
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
End If
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub

注意事項：

• 1）。VBA コード内で、「メールアドレス 1/2/3/4」を実際の受信者のメールアドレスに置き換えてください。
• 2）。「aaa.htm」、「bbb.htm」および「ccc.htm」は、それぞれ対応する受信者に送信される指定された署名です。
• 3）。この場合、「aaa」という署名が「メールアドレス 1」に送信され、「bbb」という署名が「メールアドレス 2」および「メールアドレス 3」に送信されます。また、「メールアドレス 4」には「ccc」という署名が埋め込まれたメールが送信されます。必要に応じて、これらを変更してください。
• 4）。メールに複数の受信者が含まれる場合、コードは最初の受信者のみを考慮し、他の受信者には最初の受信者と同じ署名が付与されたメールが送信されます。

7。「ツール」＞「参照設定」をクリックして、「参照設定 - プロジェクト」ダイアログボックスを開きます。ダイアログ内で「Microsoft Word オブジェクトライブラリ」と「Microsoft Scripting Runtime」の両方にチェックを入れて、「OK」ボタンをクリックしてください。スクリーンショットをご参照ください：

8。「Alt+Q」キーを押すと、「Microsoft Visual Basic for Applications」ウィンドウが閉じます。

これ以降、メールを作成して［送信］ボタンをクリックすると、宛先欄に指定された受信者のメールアドレスに基づき、対応する署名がメール本文の末尾に自動的に挿入されます。

---