【VBA】Outlookメールで全添付&全員返信するマクロ

Outlookで選択中のメールに対して、全ての添付ファイルを保持したまま全員返信するマクロです。

マクロ実行の様子

こんなんOutlookの標準機能であるだろ！と思いきや、これが意外にも無いんですよね。

Private Declare PtrSafe Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" (ByVal Hwnd As LongPtr, ByVal IpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageID As Long, ByVal dwMilliseconds As Long) As Long

'アクティブなメールを選択し、全ての添付ファイルを保持したまま全員返信するマクロ
Public Sub ReplyAll_with_Attachments()
    
　'起動中のOutlookアプリケーションを取得
　Dim OutlookApp As Object
　On Error Resume Next
　Set OutlookApp = GetObject(, "Outlook.Application")
　If OutlookApp Is Nothing Then
　　Set OutlookApp = CreateObject("Outlook.Application")
　End If
　On Error GoTo 0
    
　'アクティブなメールを取得
　Dim SelectedMail As Object 'Outlook.MailItem
　On Error Resume Next
　Set SelectedMail = OutlookApp.ActiveInspector.CurrentItem
　On Error GoTo 0
　Set OutlookApp = Nothing '以降不要なためインスタンス破棄
　If SelectedMail Is Nothing Then
　　MessageBoxTimeout 0, "アクティブなメールが見つかりません", "マクロ実行結果", vbOKOnly, 0, 1000
　　Exit Sub
　End If
　If SelectedMail.Class <> 43 Then
　　MessageBoxTimeout 0, "アクティブなメールが取得できません", "マクロ実行結果", vbOKOnly, 0, 1000
　　Exit Sub
　End If

　'全員返信メールを作成
　Dim oReply As Object 'Outlook.MailItem
　Set oReply = SelectedMail.ReplyAll

　'オリジナルのメールから添付ファイルを全て追加
　Dim i As Integer
　Dim oAttachment As Object  'Outlook.Attachment
　Dim tempFileName As String
　Dim Num As Integer
　Dim SavedFiles() As String '添付ファイル名を格納する配列
　ReDim SavedFiles(0)
　For i = 1 To SelectedMail.Attachments.Count
　　'添付ファイルを仮置きフォルダに一時保存＆メール添付
　　Set oAttachment = SelectedMail.Attachments.Item(i)
　　tempFileName = Environ("TEMP") & "\" & oAttachment.Filename
　　oAttachment.SaveAsFile tempFileName
　　oReply.Attachments.Add tempFileName
　　'保存したファイル名を配列に格納
　　Num = Num + 1
　　ReDim Preserve SavedFiles(Num)
　　SavedFiles(Num - 1) = tempFileName
　Next

　'新しいメールを表示
　oReply.Display
    
　'仮置きフォルダ内に一時保存したファイルを削除
　Dim fso As Object
　If UBound(SavedFiles) > 0 Then
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　For i = 0 To UBound(SavedFiles)
　　　If fso.fileexists(SavedFiles(i)) Then
　　　　fso.DeleteFile SavedFiles(i)
　　　End If
　　Next
　　Set fso = Nothing
　End If
    
　'念のためインスタンス破棄
　Set SelectedMail = Nothing
　Set oReply = Nothing
　Set oAttachment = Nothing

End Sub

このマクロを、Outlookのメッセージウィンドウのクイックアクセスツールバーに登録して、使ってください。
※メインウィンドウのクイックアクセスツールバーではありません。
※メッセージウィンドウとは個別のメールが表示される画面であり、メインウィンドウとは「ビュー」や「閲覧ウィンドウ」が表示される画面です。クイックアクセスツールバーには2通りあるので、混同しないように注意してください。

クイックアクセスツールバーに自作マクロを登録しておけば、アイコン化してすぐ起動できるうえ、ショートカットキー「Alt+◯」も有効になります。作業スペースを圧迫しないので邪魔にもなりません。

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

【クイックアクセスツールバーの設定手順】
①Outlookメッセージウィンドウを開く
　（何のメールでもいいので、メールを別ウィンドウで開く）
②Outlookメッセージウィンドウ>ファイル>オプション>クイックアクセスツールバー>コマンドの選択で「マクロ」を選択>任意のプロシージャを選んで「追加」>「OK」

因みに、Outlookに限らずOffice製品共通ですが、クイックアクセスツールバーへ登録するマクロは、必ずPublicプロシージャで宣言します。
アイコンは自由に見た目を変えられるので、好みのイメージに変えてください。
※手順②の「追加」のあと「変更」ボタンを押すと以下画面が出てきます。

Outlookで選択可能なアイコン画像一覧

このマクロは、受信メールに対しても、送信済みメールに対しても使えます。例えば、前者なら「添付ファイルの○○部分はこうで、△△部分はこうです。」と添付ファイルをそのまま活用して全員返信したい場合に便利です。後者なら「以前送った○○の件、進捗いかがですか？」といったフォローメールやリマインドメールを送りたい場合に使えます。