📧

[Outlook VBA]複数アカウントでも可!自動で自分のメールアドレスをBCCに追加

2023/07/19に公開

概要

私はすべてのメールを受信トレイで確認できるようにする為、メールの新規作成/返信/全返信/転送など自身からリアクションする場合は、
必ず自身のメールアドレスをBCCに追加してメールを送信しています。
Outlookで1アカウントのみ利用している場合は、Outlook標準機能のクイック操作により自動化が可能ですが、
クイック操作のメールアドレス設定は、固定値となる為、複数アカウントの場合は自動化できません。
 
そこで今回、複数アカウントでも自動化可能な方法を調べた結果、「 Outlook VBA × クイック アクセス ツール バー 」という組合せで、
実現できたので設定方法を紹介します。

この記事のターゲット

  • Windowsユーザー & Outlookユーザー の方
    Macユーザーの方は、Outlookのオプションにメッセージの送信時、自動的にBCCに自分を追加という設定があり簡単に自動化が可能
  • Outlookに複数アカウントを登録している方
    アカウントが1つのみであれば、Outlook標準機能のクイック操作により自動化が可能
  • メールでリアクション(新規作成や個別返信、全返信、転送)する際、自動的に自分のメールアドレスをBCCに追加したい方
  • 簡単なキーボード操作(ショートカットキー)でも実行したい方

環境

Officeのバージョン

Officeのバージョンは「Microsoft Office Standard 2019」

コマンドでバージョン確認した結果
PS C:\WINDOWS\system32> Get-ChildItem -Path('HKLM:SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall',
>> 'HKCU:SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall') |
>> % { Get-ItemProperty $_.PsPath | Select-Object DisplayName, DisplayVersion, Publisher } |
>> ? { $_.DisplayName -like '*Office Standard*' }

DisplayName                            DisplayVersion   Publisher
-----------                            --------------   ---------
Microsoft Office Standard 2019 - ja-jp 16.0.10399.20000 Microsoft Corporation


PS C:\WINDOWS\system32>
参考情報:PowerShellのCLIでOfficeのバージョンを確認する方法 < クリックで折りたたみが開く >

設定方法

大まかな設定の流れとしては、最初にOutlook VBAで新規モジュールを作成し自動化プログラム(Subプロシージャ)をコーディングします。
その後、作成したSubプロシージャを Outlookの左上のボタン(クイック アクセス ツール バー) に登録する事で、マウスやキーボードで簡単に操作が可能となります。
 
それでは設定方法を説明します。

Outlook VBA で自動化プログラムを作成

  • 開発環境の準備
    1. (任意)Outlookのリボンに開発を追加
      OutlookでVBAを使用する準備としてリボンに開発を追加
      • ファイル → オプション により、Outlook のオプションを表示
      • リボンのユーザー設定 → ウィンドウ右側のリボンのユーザー設定(B):枠内にある 開発のチェックボックスをオンに変更
      • OKボタン
  • 標準モジュールを新規作成とSubプロシージャの作成
    1. 標準モジュールの新規作成
      • VBAエディター[1:1]を起動

        • マウス操作の場合  :リボン開発Visual Basic をクリックし起動

        または

        • キーボード操作の場合:Alt + F11 により起動
      • 標準モジュールを新規作成

        1. 左側ツリー状のルートにある Project1 (VbaProject.OTM) を右クリック
        2. 挿入(N) を選択
        3. 標準モジュール(M) を選択
        4. (任意)モジュール名の変更
          プログラムの動作に直接関係しない処理の為、対応しなくても問題ない。
          ここで名前を変更しない場合は、以降に登場するmdlCommonModule1 に読み換えて対応。
          • モジュール名を Module1 から mdlCommon に変更
            1. Project1 (VbaProject.OTM)標準モジュールModule1 を選択
            2. VBAエディターの左下にあるプロパティよりオブジェクト名を mdlCommon に変更
              プロパティが表示されていない場合、対象モジュールをツリーで選択した状態でF4を入力すると表示できる。
    2. Subプロシージャの作成
      • mdlCommon内に自動化プログラムをコーディング

        mdlCommonに追加するコード
        Option Explicit
        
        '********************************************************************************
        '* 処理名 |CreateNewemailWithAddedToBCC
        '* 機能  |メール新規作成 + BCCに追加(アクティブアカウントのアドレス)
        '*-------------------------------------------------------------------------------
        '* 戻り値 |-
        '* 引数  |-
        '********************************************************************************
        Public Sub CreateNewemailWithAddedToBCC()
            ' Outlookメール作成用
            Dim OutlookApp As New Outlook.Application
            Dim OutlookMailitem As Outlook.MailItem
            Set OutlookMailitem = OutlookApp.CreateItem(olMailItem)
            
            ' アクティブアカウントの情報
            Dim OutlookFolder As Outlook.Folder
            Set OutlookFolder = ActiveExplorer.CurrentFolder
            
            Dim strSenderaddress As String
            strSenderaddress = AcquisitionSenderaddress(OutlookFolder)
            
            With OutlookMailitem
                .BCC = strSenderaddress
                .Display
            End With
        End Sub
        '********************************************************************************
        '* 処理名 |ReplyEmailWithAddedToBCC
        '* 機能  |メールを返信 + BCCに追加(アクティブアカウントのアドレス)
        '*-------------------------------------------------------------------------------
        '* 戻り値 |-
        '* 引数  |-
        '********************************************************************************
        Public Sub ReplyEmailWithAddedToBCC()
            ' Outlookメール作成用
            Dim OutlookMailitem As Outlook.MailItem
        
            ' 個別ウィンドウで開いているメールに対しリアクション
            ' (個別ウィンドウを開いていない場合は処理が`On Error GoTo 0`までスキップされ、
            '  OutlookMailitem の中身は Nothing となる)
            On Error Resume Next
            Set OutlookMailitem = ActiveInspector.CurrentItem.Reply
            On Error GoTo 0
        
            If OutlookMailitem Is Nothing Then
                ' Outlookで選択中のメールに対しリアクション
                Set OutlookMailitem = ActiveExplorer.Selection.Item(1).Reply
            End If
            
            ' アクティブアカウントの情報
            Dim OutlookFolder As Object
            Set OutlookFolder = ActiveExplorer.CurrentFolder
            
            Dim strSenderaddress As String
            strSenderaddress = AcquisitionSenderaddress(OutlookFolder)
            
            With OutlookMailitem
                .Display
                .BCC = strSenderaddress
            End With
        End Sub
        '********************************************************************************
        '* 処理名 |ReplyAllemailWithAddedToBCC
        '* 機能  |メールを全員に返信 + BCCに追加(アクティブアカウントのアドレス)
        '*-------------------------------------------------------------------------------
        '* 戻り値 |-
        '* 引数  |-
        '********************************************************************************
        Public Sub ReplyAllemailWithAddedToBCC()
            ' Outlookメール作成用
            Dim OutlookMailitem As Outlook.MailItem
        
            ' 個別ウィンドウで開いているメールに対しリアクション
            ' (個別ウィンドウを開いていない場合は処理が`On Error GoTo 0`までスキップされ、
            '  OutlookMailitem の中身は Nothing となる)
            On Error Resume Next
            Set OutlookMailitem = ActiveInspector.CurrentItem.ReplyAll
            On Error GoTo 0
        
            If OutlookMailitem Is Nothing Then
                ' Outlookで選択中のメールに対しリアクション
                Set OutlookMailitem = ActiveExplorer.Selection.Item(1).ReplyAll
            End If
            
            ' アクティブアカウントの情報
            Dim OutlookFolder As Object
            Set OutlookFolder = ActiveExplorer.CurrentFolder
            
            Dim strSenderaddress As String
            strSenderaddress = AcquisitionSenderaddress(OutlookFolder)
            
            With OutlookMailitem
                .Display
                .BCC = strSenderaddress
            End With
        End Sub
        '********************************************************************************
        '* 処理名 |ForwardEmailWithAddedToBCC
        '* 機能  |メールを転送 + BCCに追加(アクティブアカウントのアドレス)
        '*-------------------------------------------------------------------------------
        '* 戻り値 |-
        '* 引数  |-
        '********************************************************************************
        Public Sub ForwardEmailWithAddedToBCC()
            ' Outlookメール作成用
            Dim OutlookMailitem As Outlook.MailItem
        
            ' 個別ウィンドウで開いているメールに対しリアクション
            ' (個別ウィンドウを開いていない場合は処理が`On Error GoTo 0`までスキップされ、
            '  OutlookMailitem の中身は Nothing となる)
            On Error Resume Next
            Set OutlookMailitem = ActiveInspector.CurrentItem.Forward
            On Error GoTo 0
            
            If OutlookMailitem Is Nothing Then
                ' Outlookで選択中のメールに対しリアクション
                Set OutlookMailitem = ActiveExplorer.Selection.Item(1).Forward
            End If
            
            ' アクティブアカウントの情報
            Dim OutlookFolder As Object
            Set OutlookFolder = ActiveExplorer.CurrentFolder
            
            Dim strSenderaddress As String
            strSenderaddress = AcquisitionSenderaddress(OutlookFolder)
            
            With OutlookMailitem
                .Display
                .BCC = strSenderaddress
            End With
        End Sub
        '********************************************************************************
        '* 処理名 |AcquisitionSenderaddress
        '* 機能  |アクティブアカウントのメールアドレスを取得
        '*-------------------------------------------------------------------------------
        '* 戻り値 |String: アクティブアカウントのメールアドレス
        '* 引数  |Outlook.Folder: アクティブのアカウント情報
        '********************************************************************************
        Private Function AcquisitionSenderaddress(OutlookFolder As Outlook.Folder) As String
            Dim strSenderaddress As String
            strSenderaddress = ""
            
            ' すべてのアカウント情報を取得
            Dim objAccounts As Object
            Set objAccounts = Application.Session.Accounts
            
            Dim objItem As Object
            For Each objItem In objAccounts
                ' アクティブアカウントの表示名と個々のアカウント情報を照合
                If OutlookFolder.Store.DisplayName = objItem.DeliveryStore.DisplayName Then
                    ' 表示名がヒットした場合、アカウント情報からメールアドレスを取得
                    strSenderaddress = objItem.CurrentUser.AddressEntry.Address
                    Exit For
                End If
            Next
            
            AcquisitionSenderaddress = strSenderaddress
        End Function
        
      • Ctrl + S で上書き保存


Outlookでマクロを有効化

  1. ファイル → オプション により、Outlook のオプションを表示
  2. セキュリティ センター → セキュリティ センターの設定(T)... をクリック
    Outlookのオプション - セキュリティ センターの画面」
  3. マクロの設定 より 有効化
    デジタル署名されたマクロに対しては警告を表示し、その他のマクロはすべて無効にする(S)(デフォルト設定)から、
    すべてのマクロを有効にする (推奨しません。危険なコードが実行される可能性があります)(N) に変更。
    Outlookのオプション - セキュリティ センター - マクロの設定、「デジタル署名されたマクロに対しては警告を表示し、その他のマクロはすべて無効にする(S)」が選択された状態
    画像:変更前
    Outlookのオプション - セキュリティ センター - マクロの設定、「すべてのマクロに対して警告を表示する(A)」が選択された状態
    画像:変更後
  4. セキュリティ センター画面のOKボタンをクリック
  5. Outlookのオプション画面のOKボタンをクリック
    前項のセキュリティ センター画面のOKボタンのクリックですでにマクロの有効化は適用されている。
    その為、このOutlookのオプション画面ではキャンセルボタンをクリックしても問題はない。
  6. Outlookの再起動

参考情報:実行時に動かずVBAエディターでデバッグ時に警告がでる場合

実行時に動かない & VBAエディターでデバッグ時に警告 < クリックで折りたたみが開く >
  • 事象

    Microsoft Visual Basic for Applicactions
    このプロジェクトのマクロは無効に設定されています。マクロを有効にする方法についてはオンライン ヘルプまたはホスト アプリケーションのドキュメントを参照してください。
    
  • 対応方法
    この記事にあるOutlookでマクロを有効化にて解決

  • 参考記事
    https://extan.jp/?p=9290
    https://afroglass.com/office_macro_error-1/


クイック アクセス ツール バー の登録

ここまでの手順で自動化プログラムの作成とマクロの有効化が完了しました。
本項、クイック アクセス ツール バーに自動化プログラムを登録する事で、すべての設定が完了となります。
 
なお、Outlookのクイック アクセス ツール バー において、メイン画面とメールを個別に開いた画面(以降、個別ウィンドウ)の設定が独立しています。
その為、メイン画面と個別ウィンドウの両方で自動化プログラムを使用したい場合は、個々で登録が必要となります。
Outlookのメイン画面
画面:Outlook - メイン画面
Outlookの個別ウィンドウ(メールを開いた状態)
画面:Outlook - 個別ウィンドウ(メールを個別に開いた画面)

設定(登録)方法

  • メイン画面での登録
    メイン画面では、すべてのフォルダーを送受信元に戻すの2つがデフォルトで登録。

    1. メイン画面で、ファイル → オプション → Outlook のオプション → クイック アクセス ツール バー を開く
    2. コマンドの選択(C) を 基本的なコマンド から マクロ を選択
    3. 作成したSubプロシージャを 追加(A)
      • メール新規作成用Subプロシージャ: Project1.CreateNewemailWithAddedToBCC
      • メール個別返信用Subプロシージャ: Project1.ReplyEmailWithAddedToBCC
      • メール全返信用Subプロシージャ : Project1.ReplyAllemailWithAddedToBCC
      • メール転送用Subプロシージャ  : Project1.ForwardEmailWithAddedToBCC

    メイン画面 - Outlookのオプション - クイック アクセス ツール バー - コマンドの選択“マクロ”で作成したマクロが表示されている状態
    画像:メイン画面 - クイック アクセス ツール バー に登録

  • 個別ウィンドウでの登録
    個別ウィンドウでは、上書き保存元に戻すやり直し前のアイテム次のアイテムの5つがデフォルトで登録。

    1. 個別ウィンドウ画面で、ファイル → オプション → Outlook のオプション → クイック アクセス ツール バー を開く
    2. コマンドの選択(C) を 基本的なコマンド から マクロ を選択
    3. 作成したSubプロシージャを 追加(A)
      • メール新規作成用Subプロシージャ: Project1.CreateNewemailWithAddedToBCC
      • メール個別返信用Subプロシージャ: Project1.ReplyEmailWithAddedToBCC
      • メール全返信用Subプロシージャ : Project1.ReplyAllemailWithAddedToBCC
      • メール転送用Subプロシージャ  : Project1.ForwardEmailWithAddedToBCC

    個別ウィンドウ - Outlookのオプション - クイック アクセス ツール バー - コマンドの選択“マクロ”で作成したマクロが表示されている状態
    画像:個別ウィンドウ - クイック アクセス ツール バー に登録

登録後のイメージ

今回の例では、デフォルトのボタン設定は変更せず、今回作成した自動化プログラム4つを単純に追加した際のイメージ。
実用性を考えるのであれば、メイン画面と個別ウィンドウの間でボタンの配置を合わせた方が同じボタンの位置・同じショートカットキーとなる為、操作しやすく便利です。

ボタンの配置 ショートカットキー 追加後の設定
(メイン画面)
追加後の設定
(個別ウィンドウ)
1個目 Alt -> 1 すべてのフォルダーを送受信 上書き保存
2個目 Alt -> 2 元に戻す 元に戻す
3個目 Alt -> 3 マクロ:メール新規作成
👆 今回、追加
やり直し
4個目 Alt -> 4 マクロ:メール個別返信
👆 今回、追加
前のアイテム
5個目 Alt -> 5 マクロ:メール全返信
👆 今回、追加
次のアイテム
6個目 Alt -> 6 マクロ:メール転送
👆 今回、追加
マクロ:メール新規作成
👆 今回、追加
7個目 Alt -> 7 (未設定) マクロ:メール個別返信
👆 今回、追加
8個目 Alt -> 8 (未設定) マクロ:メール全返信
👆 今回、追加
9個目 Alt -> 9 (未設定) マクロ:メール転送
👆 今回、追加

Outlookのメイン画面でマクロが登録されたクイック アクセス ツール バー の状態
画像:メイン画面 - 登録後のイメージ
Outlookの個別ウィンドウ(個別メールを開いた状態)でマクロが登録されたクイック アクセス ツール バー の状態
画像:個別ウィンドウ - 登録後のイメージ

利用方法

自動化プログラムを実行する方法は下記の3種類あります。

  • クイック アクセス ツール バー で実行(ショートカットキー操作)
  • クイック アクセス ツール バー で実行(マウス操作)
  • マクロ一覧より実行

クイック アクセス ツール バー で実行(ショートカットキー操作)

オススメの実行方法です。
クイック アクセス ツール バー に登録すると自動的に割り当てられるショートカットキーを入力し実行。
 
下記は設定後に自動で割り当てられるショートカットキーです。

参考情報:ショートカット一覧 < クリックで折りたたみが開く >
ボタンの配置 ショートカットキー 初期設定
(メイン画面)
初期設定
(個別ウィンドウ)
1個目 Alt -> 1 すべてのフォルダーを送受信 上書き保存
2個目 Alt -> 2 元に戻す 元に戻す
3個目 Alt -> 3 (未設定) やり直し
4個目 Alt -> 4 (未設定) 前のアイテム
5個目 Alt -> 5 (未設定) 次のアイテム
6個目 Alt -> 6 (未設定) (未設定)
7個目 Alt -> 7 (未設定) (未設定)
8個目 Alt -> 8 (未設定) (未設定)
9個目 Alt -> 9 (未設定) (未設定)
10個目 Alt -> 0 -> 9 (未設定) (未設定)
11個目 Alt -> 0 -> 8 (未設定) (未設定)
12個目 Alt -> 0 -> 7 (未設定) (未設定)
13個目 Alt -> 0 -> 6 (未設定) (未設定)
14個目 Alt -> 0 -> 5 (未設定) (未設定)
15個目 Alt -> 0 -> 4 (未設定) (未設定)
16個目 Alt -> 0 -> 3 (未設定) (未設定)
17個目 Alt -> 0 -> 2 (未設定) (未設定)
18個目 Alt -> 0 -> 1 (未設定) (未設定)
19個目 Alt -> 0 -> A (未設定) (未設定)
以降は省略 - - -

クイック アクセス ツール バー で実行(マウス操作)

一番単純。
Outlookのメイン画面、もしくは個別ウィンドウより登録した左上のボタンをクリックし実行。

マクロ一覧から実行

クイック アクセス ツール バー に登録しなくても実行可能。少し手順が多い。
マクロ一覧を「 Alt + F8 」で呼び出し、対象のSubプロシージャを選択した状態でEnterキーを入力し実行。

参考情報

https://access-skill.com/vba-create-outlook-mail/
https://www.fulogabc.net/entry/excelvba-outlook-username
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14231305039
https://learn.microsoft.com/ja-jp/office/vba/outlook/concepts/accounts/create-a-sendable-item-for-a-specific-account-based-on-the-current-folder-outloo
https://extan.jp/?p=4832
https://officevba.info/outlookreply/

まとめ

  • Outlook VBAで複数アカウントでも自身のメールアドレスを自動でBCCに追加できた
  • クイック アクセス ツール バー でショートカットキーを割り当てることもできた
  • マクロの設定は必要に応じて見直す必要あり
    ここで紹介したマクロの設定、すべてのマクロを有効にするはMicrosoftで推奨されていない設定。
    必要に応じてVBAに電子証明書を設定する。

関連記事

https://zenn.dev/haretokidoki/articles/152e606290b9a5
https://haretokidoki-blog.com/pasocon_microsoft365/

脚注
  1. VBAエディター = Microsoft Visual Basic for Applications ↩︎ ↩︎

GitHubで編集を提案

Discussion