メインコンテンツへスキップ

複数の電子メールのすべての添付ファイルをOutlookのフォルダーに保存するにはどうすればよいですか?

Outlookに組み込まれている[すべての添付ファイルを保存]機能を使用すると、電子メールからすべての添付ファイルを簡単に保存できます。 ただし、複数の電子メールのすべての添付ファイルを一度に保存する場合は、直接的な機能はありません。 すべての添付ファイルがそれらの電子メールから保存されるまで、各電子メールにすべての添付ファイルを保存機能を繰り返し適用する必要があります。 それは時間がかかります。 この記事では、Outlookで複数の電子メールのすべての添付ファイルを特定のフォルダーに簡単に一括保存するためのXNUMXつの方法を紹介します。

複数の電子メールのすべての添付ファイルをVBAコードでフォルダーに保存します
素晴らしいツールを使用して、複数の電子メールからフォルダにすべての添付ファイルを保存するための数回のクリック


複数の電子メールのすべての添付ファイルをVBAコードでフォルダーに保存します

このセクションでは、ステップバイステップガイドのVBAコードを示し、複数の電子メールのすべての添付ファイルを一度に特定のフォルダーにすばやく保存するのに役立ちます。 次のようにしてください。

1.まず、添付ファイルをコンピューターに保存するためのフォルダーを作成する必要があります。

入る 資料 フォルダを作成し、という名前のフォルダを作成します 「添付ファイル」。 スクリーンショットを参照してください:

2.添付ファイルを保存するメールを選択し、を押します 他の + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

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スクリプトランタイム 内箱 参考資料-プロジェクト ダイアログボックス;

添付ファイルを保存するドキュメント07

2)重複する添付ファイル名を確認する場合は、VBAコード2を適用してください。コードを実行すると、重複する添付ファイルを置き換えるかどうかを確認するダイアログがポップアップ表示されます。 有り or いいえ あなたのニーズに基づいて。

5。 プレス F5 コードを実行するためのキー。

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

注意: あるかもしれません Microsoft Outlookの プロンプトボックスが表示されたら、をクリックしてください 次を許可します。 先に進むためのボタン。


すばらしいツールを使用して、複数の電子メールのすべての添付ファイルをフォルダに保存します

VBAの初心者の場合は、ここで強くお勧めします すべての添付ファイルを保存 の有用性 Outook用のKutools あなたのために。 このユーティリティを使用すると、Outlookで数回クリックするだけで、複数の電子メールのすべての添付ファイルを一度にすばやく保存できます。
機能を適用する前に、 最初にKutoolsforOutlookをダウンロードしてインストールします.

1.保存する添付ファイルを含むメールを選択します。

ヒント: を押し続けると、隣接していない複数のメールを選択できます Ctrlキー キーを押して、XNUMXつずつ選択します。
または、を押したままにして、隣接する複数のメールを選択します シフト キーを押して、最初のメールと最後のメールを選択します。

2。 クリック クツール >アタッチメントツールすべてを救う。 スクリーンショットを参照してください:

3。 の中に [設定の保存] ダイアログで、 ボタンをクリックして添付ファイルを保存するフォルダを選択し、[ OK

3。 クリック OK 次のポップアップダイアログボックスでXNUMX回、選択した電子メールのすべての添付ファイルが一度に指定したフォルダに保存されます。

注意:

  • 1.メールに基づいて別のフォルダに添付ファイルを保存する場合は、 次のスタイルでサブフォルダーを作成します ボックスをクリックし、ドロップダウンからフォルダスタイルを選択します。
  • 2.すべての添付ファイルを保存する以外に、特定の条件で添付ファイルを保存できます。 たとえば、ファイル名に「請求書」という単語が含まれているPDF添付ファイルのみを保存する場合は、[ 詳細オプション ボタンをクリックして条件を展開し、次に示すように構成します。
  • 3.電子メールの到着時に添付ファイルを自動的に保存する場合は、 添付ファイルの自動保存 機能が役立ちます。
  • 4.選択した電子メールから添付ファイルを直接切り離すには、 すべての添付ファイルを切り離します の特徴 Outlook用Kutools あなたに好意を与えることができます。

  このユーティリティの無料トライアル(60日)が必要な場合は、 クリックしてダウンロードしてください、次に、上記の手順に従って操作を適用します。


関連記事

Outlookの電子メールメッセージの本文に添付ファイルを挿入します
通常、添付ファイルは、作成する電子メールの[添付ファイル]フィールドに表示されます。 このチュートリアルでは、Outlookの電子メール本文に添付ファイルを簡単に挿入するのに役立つ方法を提供します。

Outlookから特定のフォルダに添付ファイルを自動的にダウンロード/保存します
一般的に、Outlookで[添付ファイル]> [すべての添付ファイルを保存]をクリックすると、XNUMXつの電子メールのすべての添付ファイルを保存できます。 しかし、受信したすべての電子メールと受信した電子メールのすべての添付ファイルを保存する必要がある場合、理想的なものはありますか? この記事では、Outlookから特定のフォルダーに添付ファイルを自動的にダウンロードするXNUMXつのソリューションを紹介します。

OutlookでXNUMXつまたは複数の電子メールにすべての添付ファイルを印刷する
ご存知のように、MicrosoftOutlookで[ファイル]> [印刷]をクリックすると、ヘッダーや本文などの電子メールコンテンツのみが印刷され、添付ファイルは印刷されません。 ここでは、MicrosoftOutlookで選択した電子メールのすべての添付ファイルを簡単に印刷する方法を紹介します。

Outlookの添付ファイル(コンテンツ)内の単語を検索する
Outlookの[インスタント検索]ボックスにキーワードを入力すると、メールの件名、本文、添付ファイルなどのキーワードが検索されます。しかし、Outlookでのみ添付ファイルのコンテンツのキーワードを検索する必要があります。 この記事では、Outlookの添付ファイルコンテンツ内の単語を簡単に検索するための詳細な手順を示します。

Outlookで返信するときに添付ファイルを保持する
Microsoft Outlookで電子メールメッセージを転送する場合、この電子メールメッセージの元の添付ファイルは転送されたメッセージに残ります。 ただし、電子メールメッセージに返信する場合、元の添付ファイルは新しい返信メッセージに添付されません。 ここでは、MicrosoftOutlookで返信するときに元の添付ファイルを保持するためのいくつかの秘訣を紹介します。


最高のオフィス生産性向上ツール

Outlook用Kutools - Outlook を強化する 100 以上の強力な機能

🤖 AIメールアシスタント: AI の魔法を備えたインスタント プロのメール - ワンクリックで天才的な返信、完璧な口調、多言語の習得。メールを簡単に変革しましょう! ...

📧 自動メール: 不在時 (POP および IMAP で利用可能)  /  メール送信のスケジュール設定  /  メール送信時のルールによる自動CC/BCC  /  自動転送 (高度なルール)   /  あいさつを自動追加   /  複数受信者の電子メールを個別のメッセージに自動的に分割する ...

📨 電子メール管理: メールを簡単に思い出す  /  件名などで詐欺メールをブロック  /  重複するメールを削除する  /  高度な検索  /  フォルダーを統合する ...

📁 アタッチメント プロバッチ保存  /  バッチデタッチ  /  バッチ圧縮  /  自動保存   /  自動デタッチ  /  自動圧縮 ...

🌟 インターフェースマジック: 😊もっと可愛くてクールな絵文字   /  タブ付きビューで Outlook の生産性を向上  /  Outlook を閉じる代わりに最小化する ...

???? ワンクリックの驚異: 受信した添付ファイルをすべてに返信する  /   フィッシングメール対策  /  🕘送信者のタイムゾーンを表示 ...

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

オーバー 100の特長 あなたの探索をお待ちしています! ここをクリックして詳細をご覧ください。

 

 

Comments (81)
Rated 3.5 out of 5 · 3 ratings
This comment was minimized by the moderator on the site
Thank you for sharing the code. Unfortunately, I tried both with failure. This is what I got - The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros. Thank you.
This comment was minimized by the moderator on the site
Hi,
Please follow the instructions in the screenshot below to check if macros are enabled in the macro settings in your Outlook. After enabling both options, re-run the VBA code.

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/macro-enabled.png
This comment was minimized by the moderator on the site
Thank you so much.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Thank you for sharing VBA code. This work like magic and is going to save it lots of time!
This comment was minimized by the moderator on the site
Hello friends!

Thanks for sharing this VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
Hi Fabiana,
Change the line 14
xFolderPath = xFolderPath & "\Attachments\"

to
xFolderPath = "C:\Users\Win10x64Test\Desktop\save attachments\1\"

Here "C:\Users\Win10x64Test\Desktop\save attachments\1\" is the folder path in my case.
Don't forget to end the folder path with a slash "\"
This comment was minimized by the moderator on the site
Hello friends!

Thank you for sharing that VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
If you are trying to run the Code that renames duplicate files and keep getting a "User Type Not Defined" error message here is the code fixed. Instead of the "Dim xFso As FileSystemObject" on line 47 it should be "Dim xFso As Variant"
Also added a Message Box to appear at the end of data transfer.

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
MsgBoX prompt:="File Transfer Complete", Title:="Sweatyjalapenos tha Goat"
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As Variant
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
This comment was minimized by the moderator on the site
Very nice script as of 2022-10-19 works great, for me doesn't seem to change original message by adding text. The only thing I changed is I added message received date time to each file name with the following format so it would nicely sort by date time in Windows folder: "yyyy-mm-dd HH-mm-ss ".

Code:

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, xDateFormat 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
xDateFormat = Format(xMailItem.ReceivedTime, "yyyy-mm-dd HH-mm-ss ")
xFilePath = xFolderPath & xDateFormat & 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
This comment was minimized by the moderator on the site
Hi Oigo,
This is a very useful VBA script. Thank you for sharing it.
This comment was minimized by the moderator on the site
Hi crystal,

sorry for not being clear.

I was trying to use the code above mentioned. However, apparently I was doing something wrong. I was thinking that I might need to amend some parts in the code shown. For instance the path where to save the attachments and maybe some other parts. Therefore I was asking if you could share the code highlighting the parts which needs tailoring and how to tailor them.

Many thanks,
BR
This comment was minimized by the moderator on the site
Hi Rokkie,
Did you get any error prompt when the code runs? Or which line in your code is highlighted? I need more details so I can see where you can modify the code.
This comment was minimized by the moderator on the site
Hey crystal,

completeley new to this VBA. Can you share a code to use which shows where I have to amend with an example? As a Rookie it is a bit difficult to figure it out.

I am working via a Ctrix connection. Could this be a blocker for the macro?

Much appreaciate the help.
This comment was minimized by the moderator on the site
Hi Rookie,
Sorry I don't understand what you mean: "Can you share a code to use which shows where I have to amend with an example?"
And the code operates on selected emails in Outlook, Ctrix Connection does not block the macro.
This comment was minimized by the moderator on the site
Hi, I am running this Code 1 to extract .txt files from separate sub-folders of an inbox. It works great out of one sub-folder but not at all out of another sub-folder. I have tried forwarding the relevant email and attachment into other inboxes but no luck. The files are automatically generated and sent to the different sub-folders and only vary by a single letter in their title

Any help much is appreciated
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations