BCCの自動設定・送信用マクロ作成例

ここでは、Outlookでメールを送信する際にBCCを自動設定して送信するためのマクロの作成例を紹介します。具体的な設定手順については本文を参照してください。

マクロを使ったBCCの自動送信設定

Outlookには自動でBCCを設定してくれる機能はありませんが、マクロを登録することで、その機能を実現することができます。

送信先アカウントが一つの場合

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next

    strBcc = "your-adress@gmail.com"

' Use the account name as it appears in Account Settings
If Item.SendUsingAccount = "プロバイダ - your-adress@provider.com" Then

    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC
    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
                 "Do you want to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Could Not Resolve Bcc")
        If res = vbNo Then
            Cancel = True
        End If
    End If

End If

    Set objRecip = Nothing
End Sub

• 9行目の “your-adress@gmail.com“の部分を自分のGmailアドレス（BCCの宛先）に書き換えます。
• 12行目の”プロバイダ – your-adress@provider.com“の部分を自動BCCを有効にしたい自分のアカウント名に書き換えます。
• このアカウント名は一字一句正確に入力する必要があります。メールアカウント設定画面を開いてコピペするのが確実です。

送信アカウントが複数ある場合

Private Sub Application_ItemSend(ByVal Item As Object, _
                                 Cancel As Boolean)
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next

    strBcc = "your-adress@gmail.com"

' Use the account name as it appears in Account Settings
If Item.SendUsingAccount = "プロバイダ - your-adress@provider.com" Then

    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC
    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
                 "Do you want to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Could Not Resolve Bcc")
        If res = vbNo Then
            Cancel = True
        End If
    End If

End If

' Use the account name as it appears in Account Settings
If Item.SendUsingAccount = "プロバイダ2 - your-adress2@provider.com" Then

    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC
    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
                 "Do you want to send the message?"
        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Could Not Resolve Bcc")
        If res = vbNo Then
            Cancel = True
        End If
    End If

End If

    Set objRecip = Nothing
End Sub

自分に合わせたコードへの書き換えが必要な個所は、前述の「送信先アカウントが一つの場合」と同じです。必要な数だけ11～26行目を繰り返してアカウントを追加します（上記の例では28～43行目が繰り返し部分）。