VBA：ExcelからOutlookのメールを特定のフォルダーにエクスポートする方法
- Outlookのメールを特定の条件で抽出して、指定したフォルダに保存したい。
１．やりたいこと
特定の期間のメールの本文に特定の文言があるときに、指定したフォルダーに保存したい。
２．サンプルコード
サンプルの出力条件は以下となります。
①本文に「Yahoo」が含まれているもの
②期間は「2021/10/01」～「2021/10/20」
ツール化する場合、保存先、検索文言、抽出期間はセルに入力された値を取得するようにする感じになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
Option Explicit Sub Save_OutlookMail() Dim OLApp As Outlook.Application Dim OLNamespace As Outlook.Namespace Dim OLFolder As Outlook.MAPIFolder Dim OLConItems As Outlook.Items Dim OLItem As Object Dim cntRow As Long Dim startDate As Date Dim endDate As Date Dim Path_SaveFolder As String Dim Path_SaveFile As String Dim Save_FileName As String '行指定' cntRow = 2 '抽出期間' startDate = Format("2021/10/01", "yyyy/mm/dd") '開始日' endDate = Format("2021/10/20", "yyyy/mm/dd") '終了日' Application.ScreenUpdating = False '保存先フォルダー' Path_SaveFolder = "C:\Users\●●\Outlook\出力フォルダー" Set OLApp = New Outlook.Application Set OLNamespace = OLApp.GetNamespace("MAPI") '(1)' '既定ユーザーの「受信トレイ」を対象に取得。デフォルトフォルダーで取得できます。' 'Set OLFolder = OLNamespace.GetDefaultFolder(olFolderInbox) ' '受信トレイの場合' '個別に作成した特定のフォルダを指定したい場合。階層を上から指定する必要があります' '以下の場合は「Outlook」配下の②「受信トレイ」にさらに作成した「01●●」フォルダー内のメールのみ検索します。' Set OLFolder = OLNamespace.Folders("Outlook").Folders("受信トレイ").Folders("01●●") Set OLConItems = OLFolder.Items '②Restrictメソッドで期間を絞り込む' Set OLConItems = OLConItems.Restrict("[ReceivedTime] >= '" & startDate & "' And [ReceivedTime] <= '" & endDate & "'") For Each OLItem In OLConItems With OLItem '①本文に「Yahoo」が含まれているもののみ抽出' If InStr(.Body, "Yahoo") = 0 Then Else '(2)' '保存するファイル名をメールから生成' Save_FileName = "「" & Left(OLItem.Subject, 20) & "」送信アドレス：" & OLItem.SenderEmailAddress '保存先のフルパス' Path_SaveFile = Path_SaveFolder & "\" & Save_FileName & ".msg" '対象のメールを指定したフォルダーに保存'" Call OLItem.SaveAs(Path_SaveFile) End If End With Next OLItem Set OLItem = Nothing Set OLConItems = Nothing Set OLFolder = Nothing Set OLNamespace = Nothing Set OLApp = Nothing Application.ScreenUpdating = True MsgBox "完了", vbInformation End Sub |
(1)検索するフォルダーの指定部分
上記サンプルコードの以下の箇所で検索するフォルダーを指定することができます。
個別に作成した特定のフォルダを指定したい場合。階層を上から指定する必要があります
|
1 2 3 4 5 6 7 |
'既定ユーザーの「受信トレイ」を対象に取得。デフォルトフォルダーで取得できます。' 'Set outFolder = outNamespace.GetDefaultFolder(olFolderInbox)' '受信トレイの場合' '個別に作成した特定のフォルダを指定したい場合。階層を上から指定する必要があります' '以下の場合は「Outlook」配下の「受信トレイ」にさらに作成した「01●●」フォルダー内のメールのみ検索します。' Set outFolder = outNamespace.Folders("Outlook").Folders("受信トレイ").Folders("01●●") Set outConItems = outFolder.Items |
(2)保存するメールのファイル名の指定
「Subject」は「タイトル」、「SenderEmailAddress」は「送信者アドレス」です。
タイトルは長すぎたり、ファイル名として使えない文字列が入っている場合があるので注意が必要です。
それ以外にも送信日時や受信者などの項目も利用することが可能です。
|
1 2 3 4 5 6 |
'保存するファイル名をメールから生成' Save_FileName = "「" & Left(OLItem.Subject, 20) & "」送信アドレス：" & OLItem.SenderEmailAddress '保存先のフルパス' Path_SaveFile = Path_SaveFolder & "\" & Save_FileName & ".msg" '対象のメールを指定したフォルダーに保存' Call OLItem.SaveAs(Path_SaveFile) |
◆関連記事
VBA：ExcelからOutlookを操作するための事前準備
【VBA】ExcelからOutlookを操作するための事前準備。参照設定の「Microsoft Outlook ●● Object Library」の設定方法
