VBA: OutlookのメールをExcelにオブジェクトとして挿入する

Outlookで受信したメールは、Excelにオブジェクトとして挿入することができるのですが、作業の手数が多く、結構面倒だったりします。

そこで、Outlookで選択しているメールを、ワンボタンでExcelに挿入する方法を考えましたので紹介します。

この記事で紹介する方法は、Excel VBAを使用するため、通常のExcelブック（xlsx）では動作しません。

事前準備として、新規Excelブックを作成、または、既存Excelブックを開き、
ファイル > 名前を付けて保存 > Excel マクロ有効ブック (*.xlsm) を選択して保存してください。

マクロ（VBA）を作成する
クイックアクセスツールバーに追加
マクロを実行する

マクロ（VBA）を作成する

Excelブック（xlsm形式）を開いている状態で、キーボードのalt + f11を押すと、Microsoft Visual Basic for Applicationsが起動します。

下図の手順で、標準モジュールを挿入します。

「VBAProject (ファイル名)」を右クリックし、挿入 > 標準モジュール

続いて、コード（後述）を貼り付けて保存します。

Sub InsertMail()
    ' 現在Outlookで選択しているメールをExcelの選択しているセルに「オブジェクトの挿入」で挿入

    Dim objMail As Outlook.MailItem
    Dim fileName As String
    Dim filePath As String
    Dim folderPath As String
    Dim outlookApp As Outlook.Application

    ' Outlookで選択しているメールを取得
    On Error Resume Next
    Set outlookApp = GetObject(, "Outlook.Application")
    Set objMail = outlookApp.ActiveExplorer.Selection(1)
    On Error GoTo 0

    If objMail Is Nothing Then
        MsgBox "Outlookでメールが選択されていません。", vbExclamation
        Exit Sub
    End If


    ' メールを保存
    folderPath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\InsertMail"
    mailTitle = objMail.Subject
    fileName = Replace(Replace(mailTitle, ":", "："), "\", "￥") & ".msg"
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    filePath = folderPath & "\" & fileName
    objMail.SaveAs (filePath)


    ' Outlookメールをオブジェクトとして挿入
    ThisWorkbook.ActiveSheet.OLEObjects.Add( _
        fileName:=filePath, _
        Link:=False, _
        DisplayAsIcon:=True _
    ).Select

End Sub

続いて、下図の手順でMicrosoft Outlook XX.X Object Libraryの参照設定を行います。