Outlook VBAを使用して、特定の受信メールの添付ファイルを指定したフォルダにダウンロード

'//--------------------------------------------------------

Sub SaveAttachmentsToFolder()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 添付ファイルを保存するフォルダを指定します。必要に応じて変更してください。
    saveFolder = "Z:\Work\" ' 保存するフォルダのパスを指定します
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            For Each olAttachment In olItem.Attachments
                ' 添付ファイルを保存します
                olAttachment.SaveAsFile saveFolder & olAttachment.fileName
            Next olAttachment
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

'//--------------------------------------------------------

Sub SaveAttachmentsFromSpecificSender()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    Dim targetSender As String
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 保存するフォルダのパスを指定します。必要に応じて変更してください。
    saveFolder = "Z:\Work\" ' 保存するフォルダのパスを指定します
    
    ' 指定した送信者のメールのみを処理するための送信者アドレスを指定します。
    targetSender = "karkun1118@outlook.jp"
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            ' 指定した送信者からのメールであるかどうかを確認します。
            If olItem.SenderEmailAddress = targetSender Then
                For Each olAttachment In olItem.Attachments
                    ' 添付ファイルを保存します
                    olAttachment.SaveAsFile saveFolder & olAttachment.fileName
                Next olAttachment
            End If
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

'//--------------------------------------------------------

Sub SaveAttachmentsWithSenderAndDate()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    Dim targetSender As String
    Dim targetSubject As String
    Dim targetSentDate As Date
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 保存するフォルダのパスを指定します。必要に応じて変更してください。
    saveFolder = "Z:\Work\" ' 保存するフォルダのパスを指定します
    
    ' 指定した送信者のメールのみを処理するための送信者アドレスを指定します。
    targetSender = "karkun1118@outlook.jp"
    
    ' 件名に含まれる文字列を指定します。
    targetSubject = "テスト"
    
    ' 指定した送信日を設定します。
    targetSentDate = Date ' 今日の日付を設定します。必要に応じて変更してください。
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            ' 指定した条件に一致するメールのみを処理します。
            If olItem.SenderEmailAddress = targetSender And InStr(1, olItem.Subject, targetSubject, vbTextCompare) > 0 And olItem.SentOn >= targetSentDate Then
                For Each olAttachment In olItem.Attachments
                    ' 送信者の名前と送信日を取得し、ファイル名に追加して保存します。
                    Dim fileName As String
                    fileName = olAttachment.fileName
                    Dim senderName As String
                    senderName = olItem.senderName
                    Dim sentDate As String
                    sentDate = Format(olItem.SentOn, "yyyy-mm-dd") ' 送信日を "yyyy-mm-dd" 形式で取得します
                    Dim savePath As String
                    savePath = saveFolder & senderName & "_" & sentDate & "_" & fileName
                    olAttachment.SaveAsFile savePath
                Next olAttachment
            End If
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub

'//--------------------------------------------------------

Sub SaveAttachmentsWithSenderAndDate()
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAttachment As Outlook.Attachment
    Dim saveFolder As String
    Dim targetSender As String
    Dim targetSubject As String
    Dim targetSentDate As Date
    
    ' 受信メールフォルダを指定します。必要に応じて変更してください。
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 保存するフォルダのパスを指定します。必要に応じて変更してください。
    saveFolder = "C:\Attachments\" ' 保存するフォルダのパスを指定します
    
    ' 指定した送信者のメールのみを処理するための送信者アドレスを指定します。
    targetSender = "example@example.com"
    
    ' 件名に含まれる文字列を指定します。
    targetSubject = "見積"
    
    ' 指定した送信日を設定します。
    targetSentDate = Date ' 今日の日付を設定します。必要に応じて変更してください。
    
    ' メールの数だけループします
    For Each olItem In olFolder.Items
        If TypeOf olItem Is MailItem Then ' メールアイテムの場合
            ' 指定した条件に一致するメールのみを処理します。
            If olItem.SenderEmailAddress = targetSender And InStr(1, olItem.Subject, targetSubject, vbTextCompare) > 0 And olItem.SentOn >= targetSentDate Then
                For Each olAttachment In olItem.Attachments
                    ' 送信者の名前と送信日を取得し、ファイル名に追加して保存します。
                    Dim fileName As String
                    fileName = olAttachment.FileName
                    Dim senderName As String
                    senderName = olItem.SenderName
                    Dim sentDate As String
                    sentDate = Format(olItem.SentOn, "yyyy-mm-dd") ' 送信日を "yyyy-mm-dd" 形式で取得します
                    Dim savePath As String
                    savePath = saveFolder & senderName & "_" & sentDate & "_" & fileName
                    olAttachment.SaveAsFile savePath
                Next olAttachment
            End If
        End If
    Next olItem
    
    ' リリースします
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
End Sub