【Outlook VBA】受信フォルダにあるメールの添付ファイルを指定フォルダに取り出す方法

皆様こんにちは、ノグチです。

前回記事では、今開いているメールの添付ファイルを、ワンクリックで指定のフォルダに保存する方法をご紹介しました。

【Outlook VBA】メールの添付ファイルをワンクリックで指定フォルダに保存する方法

複数回の連載で、Outlookのメール添付ファイルを、マクロ実行のワンステップで指定フォルダに保存する方法をご紹介しています。今回は連載の仕上げ、AttachmentsコレクションからAttachmentオブジェクトを取得して、SaveAsFileメソッドで添付ファイルを指定フォルダに保存する方法をご紹介しています。

そして以前の記事で、エクセルVBAで、受信メールフォルダ内のメールの内容をエクセルワークシートに書き出す方法もご紹介しています。

今回は、この二つの方法を組み合わせて、受信メールフォルダにある全メールの添付ファイルを、ワンクリックで指定フォルダに保存する方法をご紹介していきます。

Outlookの仕分けルールで添付ファイルを取り出したいメールをサブフォルダに集めておく
おさらい①サブフォルダのFloderオブジェクトを取得
おさらい②フォルダ内のメールのオブジェクトを取得
おさらい③メール添付ファイルのAttachmentオブジェクトの取得
サブフォルダ内のメール添付ファイルを指定フォルダに保存するコード
1. ワンクリックでサブフォルダ内の全添付ファイルを指定フォルダに保存
最後に
連載目次：Outlook VBAでメールの添付ファイルを操作しよう

Outlookの仕分けルールで添付ファイルを取り出したいメールをサブフォルダに集めておく

受信フォルダ内のメール全ての添付ファイルを取り出したい！という要望はあまりないと思います。

「このプロジェクトに関連するメール」や、「特定の取引先から送られてくるメール」など、添付ファイルを取り出したいメールの条件がありますよね。

なので、まずはOutlookの仕分けルールを使って、添付ファイルを取り出したいメールを1つのフォルダに集めてしまいましょう。

Outlookの自動仕分けウィザードを使って、「議事録」というタイトルのメールを、受信フォルダ内の「議事録」というサブフォルダに集めてしまいます。

おさらい①サブフォルダのFloderオブジェクトを取得

まずは添付ファイルを取り出すフォルダのオブジェクトを取得しましょう。

今回は受信フォルダ内のサブフォルダが対象なので、このサブフォルダのFolderオブジェクトの取得が必要ですね。

なので、まずはこのFolderオブジェクトの取得コードを用意します。

Sub SaveAttachmentFiles()
Dim myNamespace As NameSpace
Dim myInbox As Object
Dim mySubfolder As Object

Set myNamespace = GetNamespace("MAPI")
Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set mySubfolder = myInbox.Folders.Item("議事録")

End Sub

受信フォルダ直下にあるサブフォルダ「議事録」のFolderオブジェクトを取得するところまでのコードです。

NameSpaceオブジェクトやGetDefaultFolderオブジェクトについては、下記記事をご覧ください。

【エクセルVBA】GetNamespaceメソッドでOutlookのデータフォルダにアクセスする方法

GetNameSpaceメソッドでOutlookのデータフォルダにアクセスする方法をご紹介しています。このメソッドでOutlookのNameSpaceオブジェクトを取得すれば、メール、連絡先、予定表などのデータフォルダにアクセスして、更にその中のデータを読込んだり、エクセルシートに書き出したりすることができますよ。

おさらい②フォルダ内のメールのオブジェクトを取得

お次はサブフォルダに格納されているメールのMailItemオブジェクトの取得です。

受信フォルダ内のMailItemオブジェクトは、FolderオブジェクトのItemsメソッドで取得できるのでしたね。

エクセルVBAでOutlookの受信メールをワークシートに書き出す方法

エクセルVBAで、outlookの受信メールフォルダ内にあるメールをワークシートに書き出す方法をご紹介しています。この方法を使えば、受信メールフォルダ内にあるメールの件名や送信日、送信者のメールアドレスやメール本文を簡単にリストにできてしまいます。

そのItemsメソッドを上のコードに追加すると、こうなります。

Sub SaveAttachmentFiles()
Dim myNamespace As NameSpace
Dim myInbox As Object
Dim mySubfolder As Object
Dim myMailItem As Object

Set myNamespace = GetNamespace("MAPI")
Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set mySubfolder = myInbox.Folders.Item("議事録")

set myMail = mySubfolder.Items(1)

End Sub

おさらい③メール添付ファイルのAttachmentオブジェクトの取得

更に、メールの添付ファイルは、MailItemオブジェクトのAttachmentsコレクションからAttachmentオブジェクトを取り出すので、上のコードのx行目にAttachmentsコレクションとAttachmentオブジェクトの取得を加えると…

set myMailItem = mySubfolder.Items(1).Attachments(1)

こんな1文になります。

サブフォルダ内のメール添付ファイルを指定フォルダに保存するコード

上のおさらい3項目でできたコードのままでは、「議事録」フォルダ内の1つめのメールの、1つの添付ファイルしか取得できません。

なので、For Each文でサブフォルダ内メールのMailItemオブジェクトを取得し、Itemメソッドで各添付ファイルのAttachmentオブジェクトをループで取得するようにコードを組み合わせます。

更に、添付ファイルを指定フォルダに保存するためのSaveAsメソッドを入れ込むと、こんなコードになります。

Sub SaveAttachmentFiles()
Dim myNamespace As NameSpace
Dim myInbox As Object
Dim mySubfolder As Object
Dim strPath As String
Dim strFile As String
Dim i As Long

Set myNamespace = GetNamespace("MAPI")

Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set mySubfolder = myInbox.Folders.Item("議事録")　　

strPath = "C:\Users\ryoku\Desktop\Folder\" '添付ファイルを保存したいフォルダ

For Each objItem In mySubfolder.Items
    With objItem
    For i = 1 To .Attachments.Count

        strFile = strPath & .Attachments.Item(i)
    .Attachments.Item(i).SaveAsFile strFile

    Next i
    End With
Next objItem

End Sub

「議事録」というフォルダ内にある全メールを対象に、各メールの添付ファイルを、デスクトップの「Folder」というフォルダに保存するコードです。