【ExcelVBA・マクロ】Outlookの受信メールを自動でExcelに転記する方法｜件名・本文・添付ファイルを一括抽出【コピペOK】

お問い合わせフォームやシステムからの通知メールを、毎回手作業でExcelに転記しているという方は多いのではないでしょうか。件名や送信者、本文といった情報は、VBAからOutlookを操作することで自動的に取得し、一覧表として整理できます。

この記事では、ExcelVBAからOutlookの受信トレイにアクセスし、条件に合うメールの件名・送信者・受信日時・本文をExcelに転記する方法と、添付ファイルを一括で保存する方法を解説します。

OutlookをVBAから操作する準備
受信トレイから条件に合うメールを転記する
添付ファイルを一括で保存する
実行時に注意したいポイント
まとめ

OutlookをVBAから操作する準備

ExcelからOutlookを操作するには、大きく分けて「参照設定を行う早期バインディング」と「参照設定不要の遅延バインディング（CreateObject/GetObject）」の2つの方法があります。この記事では、配布先の環境でOutlookのバージョンが異なっても動作するよう、参照設定が不要な遅延バインディングで解説します。

すでにOutlookが起動している場合はそのアプリケーションを使い、起動していなければ新たに起動する、という処理を先頭に入れておくと安定して動作します。

Function GetOutlookApp() As Object

    Dim outlookApp As Object

    On Error Resume Next
    Set outlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If outlookApp Is Nothing Then
        Set outlookApp = CreateObject("Outlook.Application")
    End If

    Set GetOutlookApp = outlookApp

End Function

受信トレイから条件に合うメールを転記する

件名に特定のキーワード（ここでは「お問い合わせ」）を含むメールだけを抽出し、受信日時・送信者名・メールアドレス・件名・本文をExcelシートに転記するマクロです。再実行時に同じメールを二重に転記しないよう、EntryID（メール固有のID）をF列に記録して重複チェックを行っています。

Sub ImportOutlookMailsToExcel()

    Const olFolderInbox As Long = 6
    Const olMail As Long = 43

    Dim outlookApp As Object
    Dim outlookNamespace As Object
    Dim inboxFolder As Object
    Dim mailItem As Object
    Dim ws As Worksheet
    Dim outputRow As Long
    Dim lastRow As Long
    Dim existingIDs As Object
    Dim r As Long

    Set ws = ThisWorkbook.Worksheets("受信メール一覧")

    '既に転記済みのEntryIDを一覧化して重複チェックに使う
    Set existingIDs = CreateObject("Scripting.Dictionary")
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    For r = 2 To lastRow
        If ws.Cells(r, "F").Value <> "" Then
            existingIDs(ws.Cells(r, "F").Value) = True
        End If
    Next r

    outputRow = lastRow + 1

    Set outlookApp = GetOutlookApp()
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    Set inboxFolder = outlookNamespace.GetDefaultFolder(olFolderInbox)

    For Each mailItem In inboxFolder.Items
        If mailItem.Class = olMail Then
            If InStr(mailItem.Subject, "お問い合わせ") > 0 Then
                If Not existingIDs.Exists(mailItem.EntryID) Then
                    ws.Cells(outputRow, "A").Value = mailItem.ReceivedTime
                    ws.Cells(outputRow, "B").Value = mailItem.SenderName
                    ws.Cells(outputRow, "C").Value = mailItem.SenderEmailAddress
                    ws.Cells(outputRow, "D").Value = mailItem.Subject
                    ws.Cells(outputRow, "E").Value = mailItem.Body
                    ws.Cells(outputRow, "F").Value = mailItem.EntryID
                    outputRow = outputRow + 1
                End If
            End If
        End If
    Next mailItem

    MsgBox "メールの転記が完了しました。", vbInformation

End Sub

mailItem.Class は、Outlookのアイテムの種類を表す数値です。会議通知や連絡先など、メール以外のアイテムが受信トレイに混ざっていることがあるため、olMail（値は43）と一致するものだけを対象にしています。

F列にはEntryIDという、メールごとに一意に割り当てられるIDを保存しています。EntryIDをキーにしたDictionaryで既存データをチェックすることで、マクロを何度実行しても同じメールが重複して転記されることはありません。

添付ファイルを一括で保存する

同じ考え方で、添付ファイル付きのメールから添付ファイルだけをフォルダに保存するマクロも作成できます。

Sub SaveAttachmentsFromInbox()

    Const olFolderInbox As Long = 6
    Const olMail As Long = 43

    Dim outlookApp As Object
    Dim outlookNamespace As Object
    Dim inboxFolder As Object
    Dim mailItem As Object
    Dim attachment As Object
    Dim saveFolder As String

    saveFolder = ThisWorkbook.Path & "\添付ファイル\"

    If Dir(saveFolder, vbDirectory) = "" Then
        MkDir saveFolder
    End If

    Set outlookApp = GetOutlookApp()
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    Set inboxFolder = outlookNamespace.GetDefaultFolder(olFolderInbox)

    For Each mailItem In inboxFolder.Items
        If mailItem.Class = olMail Then
            If mailItem.Attachments.Count > 0 Then
                For Each attachment In mailItem.Attachments
                    attachment.SaveAsFile saveFolder & attachment.FileName
                Next attachment
            End If
        End If
    Next mailItem

    MsgBox "添付ファイルの保存が完了しました。", vbInformation

End Sub

同じファイル名の添付が複数のメールにある場合は上書きされてしまうため、実務で使う際は保存先ファイル名の先頭に受信日時やメール件名を付けるなど、ファイル名が重複しない工夫を加えることをおすすめします。

実行時に注意したいポイント

受信トレイのメール件数が多いと、For Each でのループに時間がかかります。件名や受信日で絞り込みたい場合は、Items.Restrict メソッドを使うと対象を先に絞り込めるため高速化できます。
Outlookのセキュリティ設定によっては、プログラムからメール情報にアクセスしようとした際に確認ダイアログが表示されることがあります。社内で配布する場合は、事前にセキュリティソフトやOutlookのプログラムアクセス設定を確認しておきましょう。
サブフォルダ（振り分けルールで移動した後のメール）を対象にしたい場合は、GetDefaultFolder(olFolderInbox).Folders("フォルダ名") のようにフォルダを指定します。

まとめ

この記事では、VBAからOutlookの受信トレイを操作し、条件に合うメールをExcelへ自動転記する方法と、添付ファイルを一括保存する方法を紹介しました。EntryIDを使った重複チェックを組み込んでおくことで、日次・週次で繰り返し実行しても安全に運用できます。

問い合わせ管理や受注メールの集計など、受信メールをもとに一覧表を作る作業は自動化との相性が良い領域です。ぜひ自分の業務に合わせてカスタマイズしてみてください。