【ExcelVBA】Outlook受信メールの添付ファイルを保存

メールで取引先や自社の営業所などから、請求書や報告書などのデータを添付ファイル付きで受信することがあると思います。メール件数が少数であるならば、手作業で1件づつ添付ファイルを取り出す手間は苦になりませんが、件数が大量の場合はすごく面倒でイライラしますよね。

OutlookのVBAもありますが、Excelから操作したいと思いませんか?
ExcelVBAでOutlookからメールに添付されているファイルを一括保存して、そのまま集計作業などが行えればものすごく効率的です!

早速、ExcelVBAでOutlookを操作する方法について紹介していきたいと思います

ExcelVBAでOutlookを扱えるようにするには

はじめに「参照設定」を行う必要があります

VBE(Visual Basic Editer)を開き、「ツール」>「参照設定」と進むと、上の画像と同じダイアログが表示されます。参照可能なライブラリファイルをスクロールして、「Microsoft Outlook ××.0 Object Library 」にチェックを入れOKを押します
Officeのバージョンにより(××.0 の部分は違う場合があります。ここでは16.0)

これで、Outlookを操作できる準備ができました

Outlook の Application オブジェクトで参照

参照が設定ができたので、New キーワードを使用して、Outlook の Application オブジェクトの新しいインスタンスを作成できます(一度に使用可能な Outlook のインスタンスは 1 つです)
Outlook が起動していない場合は、Outlook の新しい非表示インスタンスが作成されます
Outlook が既に実行されている場合には、 New キーワードまたは CreateObject 関数を使用すると、新たにインスタンスが作成されるのではなく、実行中のインスタンスへの参照が返されます

New キーワードとCreateObject 関数はこれ

'Outlookアプリケーションのインスタンスを作成(起動)
Dim app As New Outlook.Application
Set app = CreateObject("Outlook.Application")

使用するその他のオブジェクトです

'Explorerオブジェクト(Outlook)フォルダーの内容が表示されるウィンドウ
Dim exp As Outlook.Explorer
Set exp = app.ActiveExplorer
'Selectionオブジェクト(Outlook)Explorerで現在選択されているOutlookアイテム
Dim sel As Outlook.Selection
Set sel = exp.Selection

OutlookのExplorerウィンドウで選択されているアイテム(メールやフォルダ)に対しての操作を行っていくための準備です

メールに添付されているファイルを一括保存

選択メール(複数選択可)から取り出すコード

・フォルダ選択ダイアログを表示して、選択しているメールの添付ファイルを保存します
※事前にOutlookで対象のメールを選択しておいてから実行してください

Sub 選択メールの添付ファイル一括保存()
    Dim olapp As Outlook.Application  'New Outlook.Application
    Dim olexp As Outlook.Explorer
    Dim olsel As Outlook.Selection
    Dim sel As Object, attFile As Object
    Dim fpath As String
    Dim pos As Long

    On Error GoTo ErrHandler
    Set olapp = CreateObject("Outlook.Application")
    Set olexp = olapp.ActiveExplorer

    '対象のメールが選択されているか確認メッセージを出す
    MsgBox "事前に対象のメールを選択しておいてくださいね!"
    
    Set olsel = olexp.Selection
    
    '添付ファイルの保存先フォルダを指定する
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            fpath = .SelectedItems(1)
        End If
    End With
  '選択されていなかったら(キャンセル)終了する
    If fpath = "" Then GoTo ExitP
    fpath = fpath & "\"
    
    'サブフォルダ「Excel」と「その他」を作成
    If Dir(fpath & "Excel", vbDirectory) = "" Then MkDir fpath & "Excel"
    If Dir(fpath & "その他", vbDirectory) = "" Then MkDir fpath & "その他"

    '添付ファイルを保存する
    For Each sel In olsel
        For Each attFile In sel.Attachments 'Attachmentsコレクション
            pos = InStrRev(attFile.DisplayName, ".")
            If pos > 0 Then
                '拡張子の3文字でExcelファイルかどうか判定
                If LCase(Mid(attFile.DisplayName, pos + 1, 3)) <> "xls" Then
                    attFile.SaveAsFile fpath & "その他\" & attFile.DisplayName
                Else
                    attFile.SaveAsFile fpath & "Excel\" & attFile.DisplayName
                End If
            End If
        Next attFile
    Next sel

    MsgBox "終了しました。", vbOKOnly + vbInformation, "添付ファイル一括保存"
    GoTo ExitP

ErrHandler:
    MsgBox "エラーが発生しました!" & vbCrLf & Err.Description, _
                                    vbExclamation, "添付ファイル一括保存"

'終了処理
ExitP:
    Set sel = Nothing
    Set attFile = Nothing
    Set olsel = Nothing
    Set olexp = Nothing
    Set olapp = Nothing
End Sub

コードの説明を少し追加

    'サブフォルダ「Excel」と「その他」を作成
    If Dir(fpath & "Excel", vbDirectory) = "" Then MkDir fpath & "Excel"
    If Dir(fpath & "その他", vbDirectory) = "" Then MkDir fpath & "その他"

👆この部分で、保存先に指定したフォルダに「Excel」と「その他」のサブフォルダを作成するようにしています
不要ならこの部分と、その下のループ部分を下記のように書き換えれば、すべての添付ファイルを指定のフォルダへ保存するように変更できます

    '添付ファイルを保存する
    For Each sel In olsel
        For Each attFile In sel.Attachments 'Attachmentsコレクション
            attFile.SaveAsFile fpath & attFile.DisplayName
        Next attFile
    Next sel

まとめ

コードを実行してみた感想

実行速度は、本当にあっという間に処理が完了します!
10個のメールから15個の添付ファイル抜き出しが2秒かかっていません!

最初にも書きましたが、ExcelVBAでOutlookから添付ファイルのExcelデータを一括保存して、そのまま集計作業を行えればものすごく効率的です!
是非使ってみてください。おすすめです(^^)

今後の記事について

今回の記事はいかがだったでしょうか。お役に立てたなら幸いです

【今後の機能追加など…】
・ExcelからOutlook 2016でのフォルダから添付ファイルを一括保存する方法
・ExcelからOutlook 2016でメールを送信する方法
・データ表から同一種別データ毎に抽出して別ファイルに分割保存する方法
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・次回はこれらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください