【Outlook VBA】受信トレイの添付ファイルを一括保存する方法!期間指定も!

Outlookで受信トレイの添付ファイルを一括保存したいときはないでしょうか。

けど、そんな中で悩むことは、

・Outlookで受信トレイの添付ファイルを一括保存したいが方法がわからない。
・Outlookで受信トレイの添付ファイルを期間指定した上で一括保存したいが方法がわからない。
・Outlookで受信トレイの添付ファイルを一括保存する際に上書きされないようにしたいが方法がわからない。

ですよね。

今回はそんなお悩みを解決する

・Outlookで受信トレイの添付ファイルを一括保存する方法
・Outlookで受信トレイの添付ファイルを期間指定した上で一括保存する方法
・Outlookで受信トレイの添付ファイルを一括保存する際に上書きしないようにする方法

についてまとめます!

Outlookで受信トレイの添付ファイルを一括保存するイメージ

Outlookで受信トレイの添付ファイルを一括保存するイメージについて説明をします。

まずは、Outlookの受信トレイにある添付ファイル付きのメールがあるか確認をします。

VBAをOutlook側へ実装し、保存先となるフォルダのパスを指定します。

また受信トレイのメールアイテムが多くあり、抽出対象を絞りたいときは期間を指定します。

VBAを実行すると、

指定期間分の添付ファイルが指定フォルダへ保存されます!

さらに同じ名前の添付ファイルがあった場合は連番を付け上書き保存されないようにもできます!

大量の添付ファイルを取得したいときに便利ですね!
早速試してみましょう。

Outlookの受信トレイにある添付ファイル付きのメールを確認する

Outlookの受信トレイにある添付ファイル付きのメールを確認しましょう。

サンプルは以下の通りです。

それぞれ同じ名前の添付ファイルが付いています。

Outlook受信トレイの添付ファイルを一括保存するVBA_期間指定版

VBAの準備

Outlook受信トレイの添付ファイルを一括保存するVBA(期間指定版)の実装方法について説明をします。

今回のサンプルコードは以下の通りです。

Sub 受信トレイの添付ファイルを一括保存_期間絞り込み()
    Dim olApp As Application
    Dim objInbox As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim objConItems
    Dim strPath As String
    Dim i As Long
    Dim j As Long
    Dim strStart As String
    Dim strEnd As String
    Dim strFileName As String
     
     
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの受信トレイを取得します。
    Set olApp = New Outlook.Application
    Set objFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set objConItems = objFolder.Items
    
    '添付ファイルの保存先をパスで指定します。
    strPath = "F:\test\添付ファイル\"

    '開始日と終了日を指定します。
    strStart = Format("2022/2/1 00:00", "yyyy/mm/dd hh:nn")  '開始日を指定
    strEnd = Format("2022/6/16 17:00", "yyyy/mm/dd hh:nn")  '終了日を指定

    'Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。
    Set objConItems = objConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")
 
    'アイテム数分処理を繰り返します。
    For Each objItem In objConItems
        For i = 1 To objItem.Attachments.Count
            
            '添付ファイル名を変数へ代入します。
            strFileName = objItem.Attachments.Item(i)
            
            '添付ファイルに拡張子がある場合のみ処理します。
            If InStr(strFileName, ".") <> 0 Then
                'ファイルを書き出します。
                objItem.Attachments.Item(i).SaveAsFile strPath & objItem.Attachments.Item(i)
            End If
        Next i
    Next objItem
 
    'オブジェクトを解放します。
    Set olApp = Nothing
    Set objFolder = Nothing
    Set objConItems = Nothing
    Set objItem = Nothing
    
    
    MsgBox "Outlook受信トレイの添付ファイル出力が完了しました!", vbInformation
    
End Sub

VBAの設定

VBAの設定箇所は以下の通りです。

添付ファイルの保存先をパスで指定します。

strPath = "F:\test\添付ファイル\"

タカヒロ
タカヒロ
パスの最後に「\」を付けるようにしてください。

抽出期間の開始日と終了日を指定します。
時間指定もできます。

strStart = Format("2022/2/1 00:00", "yyyy/mm/dd hh:nn") '開始日を指定
strEnd = Format("2022/6/16 17:00", "yyyy/mm/dd hh:nn") '終了日を指定

VBAの実装

「VBAの実装手順」をご参照ください。

VBAの実行

VBAを実行してみましょう。

「Outlook受信トレイの添付ファイル出力が完了しました!」と表示されたら完了です。

保存先のフォルダを見てみましょう。

はい、添付ファイルが保存されていますね!

タカヒロ
タカヒロ
今回は3つのメールすべて同じ名前の添付ファイルであるため、上書きされる形となります。
次の章では上書きせず、リネームして保存する方法について載せていますので上書きしたくない方はこちらもご参照ください。

VBAの説明

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの受信トレイを取得します。

Set olApp = New Outlook.Application
Set objFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set objConItems = objFolder.Items

タカヒロ
タカヒロ
2階層目のサブフォルダを指定する場合は
Set objConItems = objFolder.Folders.Item(“サブフォルダ1”).Items
としてください。

Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。

Set objConItems = objConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")

アイテム数分処理を繰り返します。

For Each objItem In objConItems
For i = 1 To objItem.Attachments.Count

添付ファイル名を変数へ代入します。

strFileName = objItem.Attachments.Item(i)

添付ファイルに拡張子がある場合のみ処理します。

If InStr(strFileName, ".") <> 0 Then

ファイルを書き出します。

objItem.Attachments.Item(i).SaveAsFile strPath & objItem.Attachments.Item(i)

Outlook受信トレイの添付ファイルを上書きしないで一括保存するVBA

VBAの準備

Outlook受信トレイの添付ファイルを上書きしないで一括保存するVBA(期間指定版)の実装方法について説明をします。

サンプルコードは以下の通りです。

Sub 受信トレイの添付ファイルを一括保存_期間絞り込み_上書き回避()
    Dim olApp As Application
    Dim objInbox As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim objConItems
    Dim strPath As String
    Dim i As Long
    Dim j As Long
    Dim strStart As String
    Dim strEnd As String
    Dim strFileName As String
     
     
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの受信トレイを取得します。
    Set olApp = New Outlook.Application
    Set objFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set objConItems = objFolder.Items
    
    '添付ファイルの保存先をパスで指定します。
    strPath = "F:\test\添付ファイル\"

    '開始日と終了日を指定します。
    strStart = Format("2022/2/1 00:00", "yyyy/mm/dd hh:nn")  '開始日を指定
    strEnd = Format("2022/6/16 17:00", "yyyy/mm/dd hh:nn")  '終了日を指定

    'Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。
    Set objConItems = objConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")
 
    'アイテム数分処理を繰り返します。
    For Each objItem In objConItems
        For i = 1 To objItem.Attachments.Count
            
            '添付ファイル名を変数へ代入します。
            strFileName = objItem.Attachments.Item(i)
            
            '添付ファイルに拡張子がある場合のみ処理します。
            If InStr(strFileName, ".") <> 0 Then
                
                'フルパスが存在しない場合のみファイルを書き出します。
                If Dir(strPath & strFileName) = "" Then
                   objItem.Attachments.Item(i).SaveAsFile strPath & strFileName
                Else
                    j = 1
                    '重複していたら保存ファイル名の先頭に(**)をつけます。
                    Do While Dir(strPath & strFileName) <> ""
                        strFileName = "(" & j & ")" & strFileName
                        j = j + 1
                    Loop
                    objItem.Attachments.Item(i).SaveAsFile strPath & strFileName

                End If
            End If
        Next i
    Next objItem
 
    'オブジェクトを解放します。
    Set olApp = Nothing
    Set objFolder = Nothing
    Set objConItems = Nothing
    Set objItem = Nothing
    
    
    MsgBox "Outlook受信トレイの添付ファイル出力が完了しました!", vbInformation
    
End Sub

VBAの設定

VBAの設定箇所は以下の通り前回と同じ内容を設定します。

添付ファイルの保存先をパスで指定します。

strPath = "F:\test\添付ファイル\"

タカヒロ
タカヒロ
パスの最後に「\」を付けるようにしてください。

抽出期間の開始日と終了日を指定します。
時間指定もできます。

strStart = Format("2022/2/1 00:00", "yyyy/mm/dd hh:nn") '開始日を指定
strEnd = Format("2022/6/16 17:00", "yyyy/mm/dd hh:nn") '終了日を指定

VBAの実行

VBAを実行してみましょう。

「Outlook受信トレイの添付ファイル出力が完了しました!」と表示されたら完了です。

保存先のフォルダを見てみましょう。

はい、添付ファイルが上書きせずれ連番付きでリネームされて保存されていますね!

VBAの説明

前回のVBAに上書きささせないよう処理を追加していますので、その部分について説明をします。

Dir(strPath & strFileName)で判定し、フルパスが存在しない場合のみファイルを書き出します。

If Dir(strPath & strFileName) = "" Then
objItem.Attachments.Item(i).SaveAsFile strPath & strFileName

重複していたら保存ファイル名の先頭に(**)をつけ添付ファイルを保存します。

Do While Dir(strPath & strFileName) <> ""
strFileName = "(" & j & ")" & strFileName
j = j + 1
Loop
objItem.Attachments.Item(i).SaveAsFile strPath & strFileName

タカヒロ
タカヒロ
リネームをせず、上書きだけ回避したい場合はこの処理を省くようにしてください。

<追加>Outlook受信トレイの指定件名の添付ファイルをリネームして一括保存するVBA

読者様よりご依頼がありました、指定した件名のみ絞り、添付ファイル名を変更した上で、指定フォルダへ保存するVBAについて説明をします。

VBAの準備

サンプルコードは以下の通りです。

Sub 受信トレイの添付ファイルを一括保存_期間絞り込み_上書き回避_件名絞り込み()
    Dim olApp As Application
    Dim objInbox As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim objConItems
    Dim strPath As String
    Dim i As Long
    Dim j As Long
    Dim strStart As String
    Dim strEnd As String
    Dim strFileName As String
    Dim strTokuteiSubject As String
     
     
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの受信トレイを取得します。
    Set olApp = New Outlook.Application
    Set objFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set objConItems = objFolder.Items
    
    '添付ファイルの保存先をパスで指定します。
    strPath = "F:\test\添付ファイル\"
    
    '絞り込みたい件名もしくはキーワードを指定します。
    strTokuteiSubject = "【重要】"

    '開始日と終了日を指定します。
    strStart = Format("2022/2/1 00:00", "yyyy/mm/dd hh:nn")  '開始日を指定
    strEnd = Format("2022/7/16 17:00", "yyyy/mm/dd hh:nn")  '終了日を指定

    'Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。
    Set objConItems = objConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")
 
    'アイテム数分処理を繰り返します。
    For Each objItem In objConItems
        For i = 1 To objItem.Attachments.Count
            
            '添付ファイル名を変数へ代入します。
            strFileName = "★重要★" & objItem.Attachments.Item(i)
            
            '添付ファイルに拡張子がある場合と特定の件名に合致した場合のみ処理します。
            If InStr(strFileName, ".") <> 0 And InStr(objItem.Subject, strTokuteiSubject) <> 0 Then
                
                'フルパスが存在しない場合のみファイルを書き出します。
                If Dir(strPath & strFileName) = "" Then
                   objItem.Attachments.Item(i).SaveAsFile strPath & strFileName
                Else
                    j = 1
                    '重複していたら保存ファイル名の先頭に(**)をつけます。
                    Do While Dir(strPath & strFileName) <> ""
                        strFileName = "(" & j & ")" & strFileName
                        j = j + 1
                    Loop
                    objItem.Attachments.Item(i).SaveAsFile strPath & strFileName

                End If
            End If
        Next i
    Next objItem
 
    'オブジェクトを解放します。
    Set olApp = Nothing
    Set objFolder = Nothing
    Set objConItems = Nothing
    Set objItem = Nothing
    
    
    MsgBox "Outlook受信トレイの添付ファイル出力が完了しました!", vbInformation
    
End Sub

VBAの設定

VBAの設定箇所は「受信トレイの添付ファイルを一括保存_期間絞り込み_上書き回避」と同じ内容を設定てください。
追加部分について以下の通りとなります。

絞り込みたい件名もしくはキーワードを指定します。

strTokuteiSubject = "【重要】"


タカヒロ
タカヒロ
“【重要】”の部分は適宜変更してください。なお前方後方一致で絞り込みますのでなるべく一意となる文字列にするようお願いします。

添付ファイル名に付加する文字列を追加します。
変更/追記する箇所は「★重要★」の箇所となります。

strFileName = "★重要★" & objItem.Attachments.Item(i)

タカヒロ
タカヒロ
ファイル名を丸ごと変えたい場合は、
“★重要★” & objItem.Attachments.Item(i)

“★重要★〇〇〇.csv”
等にするようお願いします。

VBAの実行

VBAを実行してみましょう。

「Outlook受信トレイの添付ファイル出力が完了しました!」と表示されたら完了です。

保存先のフォルダを見てみましょう。

はい、指定件名に絞り込まれ、その添付ファイルがリネームされて保存されていますね!

VBAの実装手順

VBAを設置する下準備をする

VBAを設置するための下準備をしましょう。

「開発」タブがリボンメニューにない場合は
以下を参考に表示させます。

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

VBAを登録する

次にマクロを登録します。

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

「Visual Basic Editor」にて、[Project1] > [Microsoft Outlook Objects] > [ThisOutlookSession] を開き、こちらにコードを貼り付けます。

こちらで実装完了です。

VBAを実行する

VBAを実行する手順となります。
①「開発」タブの「VBA」をクリックし実行したいマクロを選択し、「実行」をクリックします。

②処理がされたことが確認できれば完了です。

さいごに

いかがでしょうか。

今回は、
【Outlook VBA】受信トレイの添付ファイルを一括保存する方法!期間指定も!について
まとめました。

また、他にも便利な方法がありますので、よろしければご参照頂ければと思います。



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。



 データ分析で四苦八苦している方にオススメ! 
Power BIをカンタン習得できるおすすめ本! 最短習得方法も!

Power BIをカンタン習得できるおすすめ本!裏技|最短習得方法も!

サクッとPowerBIでデータ分析できる人になりましょう!

タカヒロ

タカヒロ
実質無料で読めるExcelVBA本についてまとめました。
もしVBA本購入を検討されていたら、どれだけお得か確かめてみてください。

【¥0】実質無料のExcelVBAおすすめ本25選!初級~中級まで網羅!

12 件のコメント

  • タカヒロ様 迅速なご回答誠にありがとうございます。
    時間がかかるとのこと、了承いたしました。毎月300件以上の添付ファイルを毎回メールを開いて、保存していたため効率化できて本当に助かりました。
    ありがとうございました。

  • タカヒロ様 大変失礼いたしました。日付を設定しておりませんでした。
    この日付なんですが、設定しない場合はその日付部分を削除すれば、マクロ実行をする段階ですべてのファイルに対して稼働いたしますでしょうか。たびたびの質問で大変恐縮です。なにとぞよろしくお願いいたします。

    • 日付の設定が影響していたこと了解いたしました。

      期間フィルタを外す場合は
      以下のコードを削除するかコメントアウトし無効化してください。
      ‘Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。
      Set objConItems = objConItems.Restrict(“[ReceivedTime] >= ‘” & strStart & “‘ And・・・

      その場合には全期間が対象となりますので、処理時間がかかってしまう可能性があることご了承ください。

  • タカヒロ様 おはようございます。お忙しい中ご回答ありがとうございます。ファイル名が重複しているものが、番号を振られてフォルダに保存されること、稼働確認いたしました!ありがとうございました。
    ただ、また問題が発生しており、重複していない名前の添付ファイルもメールの中にはありまして、それらがフォルダへ移動しない仕様になってしまいました。
    拡張子がついているファイルを指定しているはずなのですが…。
    重複しないファイルも一緒にフォルダへ移動させたいのですが、なにか方法はございますでしょうか。宜しくお願いいたします。

  • タカヒロ様 誠に迅速なご回答、非常に助かります。ほんとありがとうございます。
    早速ですが、直下のフォルダ名は問題ないと思われます…。
    実は、重複を回避するVBAを教えていただく前に、添付ファイルをフォルダに保存するというVBAを使用させていただき、うまく稼働いたしまして、その部分を貼り付けただけなんです。なので、フォルダ名や場所などは問題ないかと思われますが、恐ろしく初心者なので、なにかやらかしてるかもしれません。。。お忙しいと思いますので、お時間のある時にでもご教示お願いいたします。

    • フォルダ名は問題ないこと承知いたしました。

      コードをみますと、オブジェクトobjFolderが後処理とつながっていないみたいですね。
      あとItemsプロパティが抜けていたので追加していただければと存じます。

      ■変更前
      Set objFolder = objInbox.Folders.Item(“★★★★サンクスカード集計”)

      ■変更後
      Set objConItems = objInbox.Folders.Item(“★★★★サンクスカード集計”).Items

  • タカヒロ様 迅速なご回答誠にありがとうございます。早速ですが、重複しないvbaを使用させていただきました。が、受信トレイを指定する段階を変更したら、オブジェクトがないとエラーになりました。恐れ入りますが、ご教示いただけますでしょうか。
    下記受信トレイを指定したつもりのコードです。
    Sub 受信トレイの添付ファイルを一括保存_期間絞り込み_上書き回避()
    Dim olApp As Application
    Dim objInbox As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim objConItems
    Dim strPath As String
    Dim i As Long
    Dim j As Long
    Dim strStart As String
    Dim strEnd As String
    Dim strFileName As String

    Set objInbox = GetNamespace(“MAPI”).GetDefaultFolder(olFolderInbox)
    ‘添付ファイルがあるメールのフォルダを指定します。2階層以上ある場合は「.Folders.Item(<フォルダ名>)」を追加してください。
    Set objFolder = objInbox.Folders.Item(“★★★★サンクスカード集計”)

    ‘添付ファイルの保存先をパスで指定します。
    strPath = “C:\Users\”

    ‘開始日と終了日を指定します。
    strStart = Format(“2022/7/1 00:00”, “yyyy/mm/dd hh:nn”) ‘開始日を指定
    strEnd = Format(“2022/7/14 15:00”, “yyyy/mm/dd hh:nn”) ‘終了日を指定

    ‘Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。
    Set objConItems = objConItems.Restrict(“[ReceivedTime] >= ‘” & strStart & “‘ And [ReceivedTime] <= '" & strEnd & "'")

    'アイテム数分処理を繰り返します。
    For Each objItem In objConItems
    For i = 1 To objItem.Attachments.Count

    '添付ファイル名を変数へ代入します。
    strFileName = objItem.Attachments.Item(i)

    '添付ファイルに拡張子がある場合のみ処理します。
    If InStr(strFileName, ".") 0 Then

    ‘フルパスが存在しない場合のみファイルを書き出します。
    If Dir(strPath & strFileName) = “” Then
    objItem.Attachments.Item(i).SaveAsFile strPath & strFileName
    Else
    j = 1
    ‘重複していたら保存ファイル名の先頭に(**)をつけます。
    Do While Dir(strPath & strFileName) “”
    strFileName = “(” & j & “)” & strFileName
    j = j + 1
    Loop
    objItem.Attachments.Item(i).SaveAsFile strPath & strFileName

    End If
    End If
    Next i
    Next objItem

    ‘オブジェクトを解放します。
    Set olApp = Nothing
    Set objFolder = Nothing
    Set objConItems = Nothing
    Set objItem = Nothing

    MsgBox “Outlook受信トレイの添付ファイル出力が完了しました!”, vbInformation

    End Sub

    • ご連絡ありがとうございます。

      オブジェクトがないエラーの件ですが、
      下記フォルダが規定のユーザの受信トレイ直下(規定のユーザ>受信トレイ>★★★★サンクスカード集計)にあるか、
      またフォルダ名は完全に一致しているかご確認頂けますでしょうか。
      Set objFolder = objInbox.Folders.Item(“★★★★サンクスカード集計”)

  • 続いてなのですが、期間を指定せず、任意の数字6桁が入っている件名を指定し、そのメールに添付されているExcelファイルを名前を付けて保存したい場合についても教えていただきたいです。数字6桁はメッセージBoxで入力するところまでは出来たのですが、その後ファイル名をその数字6桁でファイル保存をするところがうまくいかず…です。
    ユニークな数字6桁の番号で件名を指定し、ファイル名もユニークになる為、
    期間指定と繰り返し(loop)も不要になると思いますが、この認識が合っているかどうかが分からず、初心者の為大変ご面倒かけます。よろしくお願いいたします。

  • outlookで添付ファイルを保存できました!
    もし可能でしたら、フォルダ内へ移動せずに受信トレイで指定したメールのみの添付ファイルに名前を付けて指定フォルダ内へ保存する。というVBAを教えていただけますでしょうか。

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です