【Outlook VBA】メールの添付ファイルを保存＆添付ファイル名一覧を取得する方法

前回、受信メールフォルダのさらにサブフォルダにあるメールの添付ファイルを指定フォルダへ保存する方法を紹介しましたが、それに添付ファイル名のリストをExcel形式で出力する方法を紹介します。

【Outlook VBA】受信したメールの添付ファイルを指定フォルダへ保存する

添付ファイルを指定のフォルダへ保存したときに気づいたこと

添付ファイルを指定フォルダへ保存したときに、どのメールの添付ファイルかわからなくなりました。件数が多いほど厄介になりそうです。

そこで添付ファイルかどのメールのものであるかわかるリストを出力する機能を追加しました。

完成イメージは以下の通りで、件名、送信者、受信日時、添付ファイル名とそのパスを項目として設け、添付ファイル単位で集計がされていく感じとなります。

マクロを設置する下準備をする。

以下を参考にVBAコードを配置する場所を表示させます。

Outlook VBAをはじめよう！初心者向け手引き

今回Excelの機能を使いますので、参照設定からExcel Objectを指定し有効化します。
[開発]タブをクリックし、「Visual Basic」ボタンをクリックします。
[ツール(T)]メニュー＞[参照設定(R)]で「Microsoft Excel XX.X Object Library」にチェックを入れます。

この設定が終えたら一度Outlookを再起動させてください。

マクロを登録する

「開発」タブ>「Visual Basic」を押します。

「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] > [ThisOutlookSession] を開きます。

右のコードエリアへ、以下のコードを貼り付けて保存します。

Sub 添付ファイルを保存かつ添付ファイルリストをExcelへ出力()

    Dim objInbox As Object
    Dim objFolder As Object
    Dim strPath As String
    Dim i As Long
    
    'Excel用定義
    Dim myExcel As Excel.Application
    Dim objBook As Excel.Workbook
    Dim objSheet As Excel.worksheet
    Dim n As Long
    
    'Excelオブジェクト生成、ブックの追加
    Set myExcel = CreateObject("Excel.Application")
    Set objBook = myExcel.Workbooks.Add()
    Set objSheet = objBook.sheets(1)

    '項目目を追加
    objSheet.Cells(1, 1) = "ID"
    objSheet.Cells(1, 2) = "件名"
    objSheet.Cells(1, 3) = "送信者"
    objSheet.Cells(1, 4) = "受信日時"
    objSheet.Cells(1, 5) = "添付ファイル"
    objSheet.Cells(1, 6) = "添付ファイルのパス"
    
    '添付ファイルリストを書き込む行の位置
    n = 2
    
     
    Set objInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    '添付ファイルがあるメールのフォルダを指定します。2階層以上ある場合は「.Folders.Item(＜フォルダ名＞)」を追加してください。
    Set objFolder = objInbox.Folders.Item("1.サブフォルダ").Folders.Item("1-1.サブフォルダ")
    
    '添付ファイルの保存先をパスで指定します。
    strPath = "C:\Users\extan\Documents\outlook_temp\"
     
    For Each objitem In objFolder.Items
        For i = 1 To objitem.Attachments.Count
            '添付ファイルに拡張子がある場合のみ処理します。
            If InStr(objitem.Attachments.Item(i), ".") <> 0 Then
                objitem.Attachments.Item(i).SaveAsFile strPath & objitem.Attachments.Item(i)
                
                'Excelへ添付ファイル情報を追加
                objSheet.Cells(n, 1) = n - 1
                objSheet.Cells(n, 2) = objitem.ConversationTopic '件名
                objSheet.Cells(n, 3) = objitem.SenderName '送信者
                objSheet.Cells(n, 4) = objitem.ReceivedTime '受信日時
                objSheet.Cells(n, 5) = objitem.Attachments.Item(i) '添付ファイル
                objSheet.Cells(n, 6) = strPath & objitem.Attachments.Item(i) '添付ファイルのパス"
                n = n + 1
            End If
        Next i
    Next objitem
 
    '添付ファイル保存場所へExcelを保存　※ファイル名は適当な名前に変えてください。
    objBook.SaveAs strPath & "添付ファイルリスト.xlsx"
 
    Set objitem = Nothing
    Set objInbox = Nothing
    Set objFolder = Nothing
    Set objSheet = Nothing

End Sub

試しに添付ファイル付きメールをフォルダへ格納して動作してみる

早速添付ファイルとExcelの添付ファイルリストが保存されるか確認をしてみましょう。

添付付きメールを二階層目の「1-1.サブフォルダ」へ移動します。

ソースコードを編集します。
添付ファイルがあるメールのフォルダを指定します。2階層以上ある場合は「.Folders.Item(＜フォルダ名＞)」を追加してください。
Set objFolder = objInbox.Folders.Item(“1.サブフォルダ”).Folders.Item(“1-1.サブフォルダ”)

添付ファイルとExcelの添付ファイルリストの保存先となるフォルダのパスを以下ソースコードの””内に指定します。
strPath = “C:\Users\extan\Documents\outlook_temp\”

次にoutlook本体に戻り「開発」タブの「マクロ」＞「添付ファイルを保存かつ添付ファイルリストをExcelへ出力」を押下します。