VBA：ExcelからOutlookの本文などメールの情報を抽出する方法
- Outlookの情報を特定の条件で抽出して、Excelで一覧にしたい。
１．やりたいこと
特定の期間のメールの本文に特定の文言があるときにExcelに一覧として抽出したい。
ひとまず以下の感じでExcel出力します。
|
２．サンプルコード
VBAを実行するExcelに「出力用」シートを作っておいてください。
Excelで「Get_OutlookData」を実行すると上のサンプルのような一覧が出力されます。
サンプルの出力条件は以下となります。
①本文に「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 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 |
Option Explicit Sub Get_OutlookData() 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 WB As Workbook Dim WS As Worksheet Dim cntRow As Long Dim startDate As Date Dim endDate As Date '行指定' cntRow = 2 '抽出期間' startDate = Format("2021/10/01", "yyyy/mm/dd") '開始日' endDate = Format("2021/10/20", "yyyy/mm/dd") '終了日' Application.ScreenUpdating = False '出力先シートをクリア' Worksheets("出力用").Cells.Clear Set WB = ThisWorkbook Set WS = WB.Worksheets("出力用") '「出力用」シートにフィールド名を生成（1行目）' With WS .Cells.ClearContents .Cells(1, 1).Value = "To" .Cells(1, 2).Value = "CC" .Cells(1, 3).Value = "BCC" .Cells(1, 4).Value = "受信日時" .Cells(1, 5).Value = "タイトル" .Cells(1, 6).Value = "本文" .Cells(1, 7).Value = "送信者" .Cells(1, 8).Value = "送信者アドレス" .Cells(1, 9).Value = "送信日時" .Cells(1, 10).Value = "受信者名" End With WS.Activate 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 If TypeName(OLItem) = "MailItem" Then Cells(cntRow, 1).Value = .To Cells(cntRow, 2).Value = .CC Cells(cntRow, 3).Value = .BCC Cells(cntRow, 4).Value = .ReceivedTime Cells(cntRow, 5).Value = .Subject Cells(cntRow, 6).Value = .Body Cells(cntRow, 7).Value = .SenderName Cells(cntRow, 8).Value = .SenderEmailAddress Cells(cntRow, 9).Value = .SentOn Cells(cntRow, 10).Value = .ReceivedByName cntRow = cntRow + 1 End If 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 |
◆関連記事
VBA：ExcelからOutlookを操作するための事前準備
【VBA】ExcelからOutlookを操作するための事前準備。参照設定の「Microsoft Outlook ●● Object Library」の設定方法
