Outlook で複数のメールに含まれるすべての添付ファイルをフォルダーに保存するには？

Outlook の標準機能「すべての添付ファイルを保存」を使えば、1 通のメールに含まれるすべての添付ファイルを簡単に保存できます。しかし、複数のメールから一度に添付ファイルをまとめて保存したい場合、そのための直接的な機能は用意されていません。その場合は、各メールごとに「すべての添付ファイルを保存」を繰り返し実行し、すべてのメールから添付ファイルを保存し終えるまで手作業で操作を続ける必要があります。この作業は非常に時間がかかります。本記事では、Outlook で複数のメールから添付ファイルを一括で特定のフォルダーに簡単に保存するための2 つの方法をご紹介します。

VBA コードで複数のメールからすべての添付ファイルをフォルダーに保存する
便利なツールで数回のクリックで複数のメールからすべての添付ファイルをフォルダーに保存

VBA コードで複数のメールからすべての添付ファイルをフォルダーに保存する

このセクションでは、複数のメールに含まれるすべての添付ファイルを、一度に特定のフォルダーにすばやく保存できる VBA コードをステップバイステップで解説します。以下の手順に従ってください。

1。まず、コンピューターに添付ファイルを保存するためのフォルダーを作成してください。

「ドキュメント」フォルダーを開き、「Attachments」という名前のフォルダーを作成してください。スクリーンショットを参照ください。

2。保存したい添付ファイルを含むメールを選択し、「Alt」＋「F11」キーを押して「Microsoft Visual Basic for Applications」ウィンドウを開きます。

3。「挿入」＞「モジュール」をクリックして「モジュール」ウィンドウを開き、以下のいずれかの VBA コードをそのウィンドウにコピーしてください。

VBA コード1：複数のメールから添付ファイルを一括保存（同名の添付ファイルをそのまま直接保存）

ヒント：このコードは、同名の添付ファイルを保存する際に、ファイル名の後に数字（1、2、3…）を付けて保存します。

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

VBA コード2：複数のメールから添付ファイルを一括保存（重複を確認）

Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

注記：

1）同じ名前の添付ファイルをすべてフォルダーに保存したい場合は、上記の「VBA コード1」をご利用ください。このコードを実行する前に、「ツール」＞「参照設定」をクリックし、「参照設定 - プロジェクト」ダイアログボックスで「Microsoft Scripting Runtime」にチェックを入れてください。

2）重複する【附件】名を確認したい場合は、「VBA コード2」をご利用ください。コード実行後、重複する添付ファイルの処理を置き換えるかどうか尋ねるダイアログが表示されますので、必要に応じて「はい」または「いいえ」を選択してください。

5。「F5」キーを押して、コードを実行しましょう。

すると、選択したメールに含まれるすべての添付ファイルが、手順1 で作成したフォルダーに保存されます。

注記：「Microsoft Outlook」のプロンプトボックスが表示された場合は、「許可」ボタンをクリックして続行してください。

便利なツールで複数のメールからすべての添付ファイルをフォルダーに保存する

VBA 初心者の方には、「Kutools for Outlook」の「すべての添付ファイルを保存」ユーティリティを強くおすすめします。この機能を使えば、Outlook 上でわずか数回のクリックで、複数のメールに含まれるすべての添付ファイルを一括して素早く保存できます。

1。保存したい添付ファイルが含まれるメールを選択します。

ヒント：「Ctrl」キーを押しながらメールを1 つずつ選択すると、隣接していない複数のメールを簡単に選べます。
または、「Shift」キーを押しながら最初のメールと最後のメールを選択すると、連続する複数のメールを一括で選択できます。

2. 「KUTOOLS PLUS」＞「添付ファイルツール」＞「すべて保存」をクリックしてください。スクリーンショットをご参照ください。

「保存設定」ダイアログで、ボタンをクリックして添付ファイルの保存先フォルダーを選択し、「OK」ボタンをクリックします。

4。次に表示されるダイアログボックスで「OK」を2 回クリックすると、選択したメールに含まれるすべての添付ファイルが指定されたフォルダーに一括で保存されます。

注記：

• 1。メールごとに添付ファイルを異なるフォルダーに保存したい場合は、「次のスタイルでサブフォルダーを作成する」チェックボックスをオンにして、ドロップダウンメニューからフォルダースタイルをお選びください。
• 2。すべての添付ファイルを保存できるだけでなく、特定の条件に基づいて必要な添付ファイルだけを保存することも可能です。たとえば、「Invoice」という単語をファイル名に含む PDF 添付ファイルのみを保存したい場合は、「詳細オプション」ボタンをクリックして条件設定を展開し、次のように設定してください。
  
• 3。メール受信時に自動的に添付ファイルを保存したいなら、添付ファイルの自動保存機能が便利です。
• 4。選択したメールから直接添付ファイルを分離するには、「Kutools for Outlook」のすべての添付ファイルを分離機能が便利です。

関連記事

---

最高の Office 生産性ツール

まったく新しいKutools for Outlook を、100 以上の驚きの機能とともに体験しましょう！今すぐダウンロード！

🤖KUTOOLS AI：高度な AI 技術を活用して、メールの返信、要約、最適化、拡張、翻訳、作成など、あらゆる操作をラクラクこなします。

📧メール自動化：自動返信（POP および IMAP 対応）/メールのスケジュール送信/メール送信時にルールに基づいて自動 CC/BCC/自動転送（高度なルール）/自動で挨拶文を追加/複数の宛先を持つメールを個別のメッセージに自動分割...

📨メール管理：メールの取り消し/件名などを基準に詐欺メールをブロック/重複したメールを削除/高度な検索/フォルダーを整理...

📁添付ファイルプロ：一括保存/一括分離/一括圧縮/自動保存/自動的に切り離す/自動圧縮...

🌟インターフェースの魅力：😊さらに美しくクールな絵文字を多数収録/重要なメールが届いた際に通知/Outlook を閉じる代わりに最小化...

👍ワンクリックの驚き：全員に【Attachment】付きで返信/フィッシングメール対策/🕘送信者の現在時刻ゾーンを表示...

👩🏼‍🤝‍👩🏻連絡先とカレンダー：選択したメールから連絡先を追加を一括登録/連絡先グループを個別のグループに分割/誕生日のリマインダーを削除...

Kutools はお好みの言語でお使いいただけます！英語、スペイン語、ドイツ語、フランス語、中国語をはじめ、40 以上の言語をサポートしています！

ワンクリックでKutools for Outlook の機能を即解放！今すぐダウンロードして、効率を飛躍的にアップさせましょう！

Kutools for Outlook の機能一覧      今すぐダウンロード      購入ページへ

🚀 ワンクリックダウンロード — Office アドインをすべて入手

強く推奨：Kutools for Office（5-in-1）

ワンクリックで5 つのインストーラーを 一括ダウンロード！ ―Kutools for Excel、Outlook、Word、PowerPointおよびOffice Tab Pro。今すぐダウンロード！

• ✅ワンクリックで簡単操作：5 つのセットアップパッケージをたった1 回のクリックで一括ダウンロードできます。
• 🚀どんな Office 作業にも対応可能：必要なときに、必要なアドインをすぐインストールできます。
• 🧰含まれるもの：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

スイートについて⬇ スイートをダウンロード💳 スイートを購入