VBAでOutlook受信メール一覧をExcelに取り込む方法!添付ファイルやサブフォルダも取得可!

VBAでOutlook受信メール一覧をExcelに取り込みたいときはないでしょうか。

けど、そんな中で悩むことは、

・VBAでOutlook受信メール一覧をExcelに取り込みたいが方法がわからない。
・VBAでOutlookサブフォルダの受信メール一覧をExcelに取り込みたいが方法がわからない。

ですよね。

今回はそんなお悩みを解決する

・VBAでOutlook受信メール一覧をExcelに取り込む方法
・VBAでOutlook受信メールの添付ファイル一覧をExcelに取り込む方法
・VBAでOutlookサブフォルダの受信メール一覧をExcelに取り込む方法

についてまとめます!

VBAでOutlook受信メール一覧をExcelに取り込むイメージ

VBAでOutlook受信メール一覧をExcelに取り込むイメージについて説明をします。

まず、Outlook側の受信トレイにあるメールを確認します。

取得したい期間を指定し、Excel側へVBAを実装、マクロを実行すると、

Excel側に受信トレイにあるメール一覧情報が取り込まれます!

さらに複数ある添付ファイル名を出力したり、

受信トレイのサブフォルダを指定したりもできます。

サブフォルダの出力結果です!

それでは早速やってみましょう!

Outlook受信メール一覧をExcelに取り込むVBA

VBAの準備

Outlook受信メール一覧をExcelに取り込むVBAの実装方法について説明をします。

今回のサンプルコードは以下の通りです。

Sub Outlook受信メール一覧を取り込む()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long

    '取得結果を記述する行番号を指定します。2の場合、2行目のセルから開始されることになります。
    lnContactCount = 2
    
    '抽出期間の開始日と終了日を指定します。
    strStart = Format("2022/2/16", "yyyy/mm/dd") '開始日を指定
    strEnd = Format("2022/2/17", "yyyy/mm/dd")  '終了日を指定
    
    'スピードアップのためスクリーンの更新を無効にします。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    '書き込み先のセルを指定し1行目にタイトルを入力します。
    With wsSheet
        .Cells.ClearContents
        .Cells(1, 1).Value = "To"
        .Cells(1, 2).Value = "CC"
        .Cells(1, 3).Value = "BCC"
        .Cells(1, 4).Value = "ReceivedTime"
        .Cells(1, 5).Value = "Subject"
        .Cells(1, 6).Value = "Body"
        .Cells(1, 7).Value = "SenderName"
        .Cells(1, 8).Value = "SenderEmailAddress"
        .Cells(1, 9).Value = "SentOn"
        .Cells(1, 10).Value = "ReceivedByName"
        .Cells(1, 11).Value = "Importance"
        .Cells(1, 12).Value = "Size"
        .Cells(1, 13).Value = "CreationTime"
        .Cells(1, 14).Value = "LastModificationTime"
        .Cells(1, 15).Value = "ReminderTime"
        .Cells(1, 16).Value = "BodyFormat"
        .Cells(1, 17).Value = "EntryID"
        
        '書式を追加します。
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    '既定ユーザーの受信トレイを対象にオブジェクトを取得します。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olConItems = olFolder.Items
    
    'Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。
    Set olConItems = olConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")

    For Each olItem In olConItems
Debug.Print TypeName(olItem)
        'アイテムのタイプが"MailItem"だった場合のみ値を取得します。※それ以外のタイプの場合はプロパティの構成が異なるためエラーとなります。
        If TypeName(olItem) = "MailItem" Then
            With olItem
                Cells(lnContactCount, 1).Value = .To
                Cells(lnContactCount, 2).Value = .CC
                Cells(lnContactCount, 3).Value = .BCC
                Cells(lnContactCount, 4).Value = .ReceivedTime
                Cells(lnContactCount, 5).Value = .Subject
                Cells(lnContactCount, 6).Value = .Body
                Cells(lnContactCount, 7).Value = .SenderName
                Cells(lnContactCount, 8).Value = .SenderEmailAddress
                Cells(lnContactCount, 9).Value = .SentOn
                Cells(lnContactCount, 10).Value = .ReceivedByName
                Cells(lnContactCount, 11).Value = .Importance
                Cells(lnContactCount, 12).Value = .Size
                Cells(lnContactCount, 13).Value = .CreationTime
                Cells(lnContactCount, 14).Value = .LastModificationTime
                Cells(lnContactCount, 15).Value = .ReminderTime
                Cells(lnContactCount, 16).Value = .BodyFormat
                Cells(lnContactCount, 17).Value = .EntryID
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    

    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlook受信メールの取り込みが完了しました!", vbInformation
    
End Sub

VBAの設定

VBAの設定箇所は以下の通りです。

抽出期間の開始日と終了日を指定します。

strStart = Format("2022/2/16", "yyyy/mm/dd") '開始日を指定
strEnd = Format("2022/2/17", "yyyy/mm/dd") '終了日を指定

取得結果を記述する行番号を指定します。2の場合、2行目のセルから開始されることになります。

lnContactCount = 2

VBAの実装

「VBAの実装手順」をご参照ください。

VBAの実行

VBAを実行する前にOutlookの受信トレイをみてみましょう。

指定期間で3件の受信メールがあることが確認できます。

VBAを実行し

「Outlook受信メールの取り込みが完了しました!」と表示されることを確認します。

Excelシートを見てみましょう。

はい、受信メール一覧がExcelに取り込まれていますね!

 

VBAの説明

Excelのブックとワークシートのオブジェクトを設定します。

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)

書き込み先のセルを指定し1行目にタイトルを入力します。


.Cells(1, 1).Value = "To"
.Cells(1, 2).Value = "CC"
.Cells(1, 3).Value = "BCC"
.Cells(1, 4).Value = "ReceivedTime"
.Cells(1, 5).Value = "Subject"
.Cells(1, 6).Value = "Body"
.Cells(1, 7).Value = "SenderName"
.Cells(1, 8).Value = "SenderEmailAddress"
.Cells(1, 9).Value = "SentOn"
.Cells(1, 10).Value = "ReceivedByName"
.Cells(1, 11).Value = "Importance"
.Cells(1, 12).Value = "Size"
.Cells(1, 13).Value = "CreationTime"
.Cells(1, 14).Value = "LastModificationTime"
.Cells(1, 15).Value = "ReminderTime"
.Cells(1, 16).Value = "BodyFormat"
.Cells(1, 17).Value = "EntryID"

書式を追加します。

With .Range("A1:Z1")
.Font.Bold = True
.Font.ColorIndex = 10
.Font.Size = 11
End With

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")

既定ユーザーの受信トレイを対象にオブジェクトを取得します。

Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set olConItems = olFolder.Items

Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。ReceivedTime(受信日)を基準にしています。

Set olConItems = olConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")

アイテムのタイプが””MailItem””だった場合のみ値を取得します。※それ以外のタイプの場合はプロパティの構成が異なるためエラーとなります。

If TypeName(olItem) = "MailItem" Then
With olItem
Cells(lnContactCount, 1).Value = .To
Cells(lnContactCount, 2).Value = .CC
Cells(lnContactCount, 3).Value = .BCC
Cells(lnContactCount, 4).Value = .ReceivedTime
Cells(lnContactCount, 5).Value = .Subject
Cells(lnContactCount, 6).Value = .Body
Cells(lnContactCount, 7).Value = .SenderName
Cells(lnContactCount, 8).Value = .SenderEmailAddress
Cells(lnContactCount, 9).Value = .SentOn
Cells(lnContactCount, 10).Value = .ReceivedByName
Cells(lnContactCount, 11).Value = .Importance
Cells(lnContactCount, 12).Value = .Size
Cells(lnContactCount, 13).Value = .CreationTime
Cells(lnContactCount, 14).Value = .LastModificationTime
Cells(lnContactCount, 15).Value = .ReminderTime
Cells(lnContactCount, 16).Value = .BodyFormat
Cells(lnContactCount, 17).Value = .EntryID
End With
lnContactCount = lnContactCount + 1
End If

各プロパティの内容は以下の通りです。

プロパティ名 説明
To To表示名
CC CC表示名
BCC BCC表示名
ReceivedTime 受信日時
Subject 件名
Body 本文
SenderName 送信者名
SenderEmailAddress 送信者メールアドレス
SentOn 送信日時
ReceivedByName 受信者名
Importance 重要度(2:高、0:低、1:中)
Size メールアイテム容量(バイト数)
CreationTime メールが作成された日時
LastModificationTime メールを更新した日時
ReminderTime リマインダーの日時
BodyFormat メールの形式の種類(1:テキスト、2:HTML、,3:リッチテキスト)
EntryID EntryID(メールアイテム固有ID)

添付ファイルを含むOutlook受信メール一覧をExcelに取り込むVBA

次に添付ファイルを含むOutlook受信メール一覧をExcelに取り込んでみましょう。

VBAの準備

サンプルコードは以下の通りです。

Sub Outlook受信メール一覧を取り込む()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long

    '取得結果を記述する行番号を指定します。2の場合、2行目のセルから開始されることになります。
    lnContactCount = 2
    
    '抽出期間の開始日と終了日を指定します。
    strStart = Format("2022/2/16", "yyyy/mm/dd") '開始日を指定
    strEnd = Format("2022/2/17", "yyyy/mm/dd")  '終了日を指定
    
    'スピードアップのためスクリーンの更新を無効にします。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    '書き込み先のセルを指定し1行目にタイトルを入力します。
    With wsSheet

        .Cells.ClearContents
        .Cells(1, 1).Value = "To"
        .Cells(1, 2).Value = "CC"
        .Cells(1, 3).Value = "BCC"
        .Cells(1, 4).Value = "ReceivedTime"
        .Cells(1, 5).Value = "Subject"
        .Cells(1, 6).Value = "Body"
        .Cells(1, 7).Value = "SenderName"
        .Cells(1, 8).Value = "SenderEmailAddress"
        .Cells(1, 9).Value = "SentOn"
        .Cells(1, 10).Value = "ReceivedByName"
        .Cells(1, 11).Value = "Importance"
        .Cells(1, 12).Value = "Size"
        .Cells(1, 13).Value = "CreationTime"
        .Cells(1, 14).Value = "LastModificationTime"
        .Cells(1, 15).Value = "ReminderTime"
        .Cells(1, 16).Value = "BodyFormat"
        .Cells(1, 17).Value = "EntryID"
        .Cells(1, 18).Value = "Attachments"
        
        '書式を追加します。
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    '既定ユーザーの受信トレイを対象にオブジェクトを取得します。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olConItems = olFolder.Items
    
    'Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。
    Set olConItems = olConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")

    For Each olItem In olConItems
Debug.Print TypeName(olItem)
        'アイテムのタイプが"MailItem"だった場合のみ値を取得します。※それ以外のタイプの場合はプロパティの構成が異なるためエラーとなります。
        If TypeName(olItem) = "MailItem" Then
            With olItem
                Cells(lnContactCount, 1).Value = .To
                Cells(lnContactCount, 2).Value = .CC
                Cells(lnContactCount, 3).Value = .BCC
                Cells(lnContactCount, 4).Value = .ReceivedTime
                Cells(lnContactCount, 5).Value = .Subject
                Cells(lnContactCount, 6).Value = .Body
                Cells(lnContactCount, 7).Value = .SenderName
                Cells(lnContactCount, 8).Value = .SenderEmailAddress
                Cells(lnContactCount, 9).Value = .SentOn
                Cells(lnContactCount, 10).Value = .ReceivedByName
                Cells(lnContactCount, 11).Value = .Importance
                Cells(lnContactCount, 12).Value = .Size
                Cells(lnContactCount, 13).Value = .CreationTime
                Cells(lnContactCount, 14).Value = .LastModificationTime
                Cells(lnContactCount, 15).Value = .ReminderTime
                Cells(lnContactCount, 16).Value = .BodyFormat
                Cells(lnContactCount, 17).Value = .EntryID
 
                ’添付ファイルの件数分添付ファイル名を出力します。
                If .Attachments.Count > 0 Then
                    For j = 1 To .Attachments.Count
                        Cells(lnContactCount, 18).Value = Cells(lnContactCount, 18).Value & "," & .Attachments(j).Filename
                    Next
                End If
                
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    

    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlook受信メールの取り込みが完了しました!", vbInformation
    
End Sub

VBAを実行

受信トレイに添付ファイル付きのメールがあることを確認しましょう。

2つの添付ファイルがあることが確認できます。

VBAを実行してみましょう。

はい、複数の添付ファイルでもきちんと出力されていますね。

VBAの説明

追加したコードは以下の通りです。

R列に”Attachments”の項目名を追加しました。

.Cells(1, 18).Value = "Attachments"

AttachmentsコレクションからItemオブジェクトを取り出し、そのFileNameプロパティからファイル名を取得しています。

If .Attachments.Count > 0 Then
For j = 1 To .Attachments.Count
Cells(lnContactCount, 18).Value = Cells(lnContactCount, 18).Value & "," & .Attachments(j).Filename
Next
End If

サブフォルダにあるOutlook受信メール一覧をExcelに取り込むVBA

最後にサブフォルダにあるOutlook受信メール一覧をExcelに取り込んでみましょう。

VBAの準備

サンプルコードは以下の通りです。

Sub Outlook受信メール一覧を取り込む()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long

    '取得結果を記述する行番号を指定します。2の場合、2行目のセルから開始されることになります。
    lnContactCount = 2
    
    '抽出期間の開始日と終了日を指定します。
    strStart = Format("2022/2/16", "yyyy/mm/dd") '開始日を指定
    strEnd = Format("2022/2/17", "yyyy/mm/dd")  '終了日を指定
    
    'スピードアップのためスクリーンの更新を無効にします。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    '書き込み先のセルを指定し1行目にタイトルを入力します。
    With wsSheet

        .Cells.ClearContents
        .Cells(1, 1).Value = "To"
        .Cells(1, 2).Value = "CC"
        .Cells(1, 3).Value = "BCC"
        .Cells(1, 4).Value = "ReceivedTime"
        .Cells(1, 5).Value = "Subject"
        .Cells(1, 6).Value = "Body"
        .Cells(1, 7).Value = "SenderName"
        .Cells(1, 8).Value = "SenderEmailAddress"
        .Cells(1, 9).Value = "SentOn"
        .Cells(1, 10).Value = "ReceivedByName"
        .Cells(1, 11).Value = "Importance"
        .Cells(1, 12).Value = "Size"
        .Cells(1, 13).Value = "CreationTime"
        .Cells(1, 14).Value = "LastModificationTime"
        .Cells(1, 15).Value = "ReminderTime"
        .Cells(1, 16).Value = "BodyFormat"
        .Cells(1, 17).Value = "EntryID"
        .Cells(1, 18).Value = "Attachments"
        
        '書式を追加します。
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    '既定ユーザーの受信トレイを対象にオブジェクトを取得します。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders("サブフォルダ")
    Set olConItems = olFolder.Items
    
    'Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。
    Set olConItems = olConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] <= '" & strEnd & "'")

    For Each olItem In olConItems
Debug.Print TypeName(olItem)
        'アイテムのタイプが"MailItem"だった場合のみ値を取得します。※それ以外のタイプの場合はプロパティの構成が異なるためエラーとなります。
        If TypeName(olItem) = "MailItem" Then
            With olItem
                Cells(lnContactCount, 1).Value = .To
                Cells(lnContactCount, 2).Value = .CC
                Cells(lnContactCount, 3).Value = .BCC
                Cells(lnContactCount, 4).Value = .ReceivedTime
                Cells(lnContactCount, 5).Value = .Subject
                Cells(lnContactCount, 6).Value = .Body
                Cells(lnContactCount, 7).Value = .SenderName
                Cells(lnContactCount, 8).Value = .SenderEmailAddress
                Cells(lnContactCount, 9).Value = .SentOn
                Cells(lnContactCount, 10).Value = .ReceivedByName
                Cells(lnContactCount, 11).Value = .Importance
                Cells(lnContactCount, 12).Value = .Size
                Cells(lnContactCount, 13).Value = .CreationTime
                Cells(lnContactCount, 14).Value = .LastModificationTime
                Cells(lnContactCount, 15).Value = .ReminderTime
                Cells(lnContactCount, 16).Value = .BodyFormat
                Cells(lnContactCount, 17).Value = .EntryID
 
                ’添付ファイルの件数分添付ファイル名を出力します。
                If .Attachments.Count > 0 Then
                    For j = 1 To .Attachments.Count
                        Cells(lnContactCount, 18).Value = Cells(lnContactCount, 18).Value & "," & .Attachments(j).Filename
                    Next
                End If
                
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    

    'スクリーンの更新を有効にします。
    Application.ScreenUpdating = True
    
    MsgBox "Outlook受信メールの取り込みが完了しました!", vbInformation
    
End Sub

VBAを設定

Foldersコレクションにフォルダ名を指定しましょう。

受信トレイにサブフォルダが無い場合は作成し、添付ファイル付きのメール含めて受信メールを作成しましょう。

サンプルではフォルダ名が”サブフォルダ”であるのでFoldersコレクションにフォルダ名は”サブフォルダ”としています。

Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders("サブフォルダ")
Set olConItems = olFolder.Items

VBAを実行する

VBAを実行しましょう。

はい、サブフォルダの受信メール一覧が出力されていますね。

VBAの説明

追加したコードは以下の通りです。
既定ユーザーの受信トレイにFoldersコレクションにフォルダ名を指定することによりサブフォルダを対象にオブジェクトを取得します。

Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders("サブフォルダ")
Set olConItems = olFolder.Items

VBAの実装手順

Excel VBAからOutlookを操作するための下準備

Excel VBAからOutlookを操作するための下準備をしていきます。

①Excelを起動し、「開発」タブをクリックします。

②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。

③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。

Excel側へVBAを実装する

Excel側にVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」+「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のマクロを入力します。

こちらで実装完了です。

VBAを実行する

VBAを実行する手順となります。
①「開発」タブの「VBA」をクリックし実行したいマクロを選択し、「実行」をクリックします。

②処理がされたことが確認できれば完了です。

さいごに

いかがでしょうか。

今回は、
VBAでOutlook受信メール一覧をExcelに取り込む方法!添付ファイルやサブフォルダも取得可!について
まとめました。

また、他にも便利な方法がありますので、よろしければご参照頂ければと思います。



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。








23 件のコメント

  • 詳しいご説明ありがとうございます。
    質問が3点ございます。
    浅学な質問で恐縮ですが、ご教示いただけますと幸いです。。

    1:抽出期間を当日起算で指定したい。
     抽出の期間設定を、日付指定ではなく。マクロ起動当日から遡って数日間(例:2週間)とすることは可能でしょうか?

    2:新規に受信したメールをエクセル上で重複なく追記したい。
     サブフォルダのメール内容をエクセルに記録、蓄積する目的なのですが、抽出した内容(受信日時等)をエクセルに記載済みの内容と照合し、新たに入手した内容の場合のみ追記していく方法が知りたいです。

    3:受信をトリガーとするマクロの起動は可能でしょうか?
    抽出対象のサブフォルダへのメール受信、Outlook上で他フォルダから対象フォルダへの移動をきっかけとするマクロの起動は可能でしょうか?
    OutlookVBAであれば可能でしょうか?

    • いつもご利用ありがとうございます。

      以下にご回答申し上げます。

      1:抽出期間を当日起算で指定したい。
       抽出の期間設定を、日付指定ではなく。マクロ起動当日から遡って数日間(例:2週間)とすることは可能でしょうか?
      ⇒VBAのDateAdd関数を使用することで実現可能です。
      サンプルコードは、現在の日付から14日前の日付をstartDateに設定していますので参考にしてください。

      Dim startDate As Date
      ‘ 14日前(2週間前)の日付を計算
      startDate = DateAdd(“d”, -14, Date)
      ‘ startDateを使用した処理をここに記述

      2:新規に受信したメールをエクセル上で重複なく追記したい。
      ⇒新しいメールを重複なく Excel に追加するには、VBA コード内にチェック機能を実装して、
      EntryID などメールの一意の識別子がExcelシートに既に存在するかどうか確認すればよいかと思います。

      3:受信をトリガーとするマクロの起動は可能でしょうか?
      ⇒マクロをトリガーすることは、Outlook VBAのNewMail、NewMailExなどのイベントハンドラーで対応ができます。
      実装方法やサンプルコードはこちらをご参照ください。
      https://extan.jp/?p=476

  • はじめまして。
    マクロ初心者です。
    このまま使用させて頂こうと思ったのですが、
    抽出期間をどこかのセルに入れると
    該当する期間に受信したメッセージを抽出するというマクロにアレンジしたいのですがどこをどう変更すれば良いのがご教授いただけないでしょうか?

    • いつもご利用ありがとうございます。

      抽出期間をセルの値から設定する件につきまして、例えば”Sheet2″シートのA1を開始日、B1を終了日にした場合、
      コードを以下のように変更すれば対応可能です。

      なお、”Sheet2″シートのA1/B1の値は”yyyy/mm/dd”の形式で入力するようお願いします。

      ■変更前
      ‘抽出期間の開始日と終了日を指定します。
      strStart = Format(“2022/2/16”, “yyyy/mm/dd”) ‘開始日を指定
      strEnd = Format(“2022/2/17”, “yyyy/mm/dd”) ‘終了日を指定

      ■変更後
      ‘抽出期間の開始日と終了日を指定します。
      strStart = Format(Sheets(“Sheet2”).Range(“A1”).Value, “yyyy/mm/dd”) ‘開始日を指定
      strEnd = Format(Sheets(“Sheet2”).Range(“B1”).Value, “yyyy/mm/dd”) ‘終了日を指定

  • 有益な情報ありがとうございます。
    質問が2点ございます。

    ①複数のフォルダーのメールを一括でExcelに取り込むことは可能でしょうか?

    もしお分かりになりましたらご教示いただけると幸いです。

    ②受信フォルダのメールを全て取り込み、そこから必要なメールだけを別シートに抽出することは可能でしょうか?

  • ご返信ありがとうございます。
    アーカイブの設定を確認してみます。
    丁寧にご教示いただき、ありがとうございました。

  • タカヒロ@extan より:
    2023年2月22日 5:25 PM
    いつもご利用ありがとうございます。

    データ取得の範囲が1年分となる件につきまして、ご認識の通りローカルPCのキャッシュデータをみておりますので、
    その範囲に依存する形になります。

    Exchangeから直接取得する方法につきましては、以下の記事の方法にて、アドレス部をご自身のアカウントに設定することで可能となりますので
    よろしければ、ご参考ください。
    https://extan.jp/?p=2243

    >>
    ご返信ありがとうございます。
    上記URL参照し、VBAコード冒頭部分を以下の様に修正しましたが、やはり取得できた期間は1年間でした(アドレス部分は自身のものに置き換え済)。
    修正する点があればご教示いただけないでしょうか?

    初心者の為理解が及ばずお手数お掛けします

    ‘Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object

    ‘Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long

     ’他人予定表の定義
    Dim strAddress As String
    Dim recOther As Recipient
    Dim objAppt As AppointmentItem
    Dim strStart As String
    Dim strEnd As String

    ‘対象予定表のアドレスを指定※予定表を変更するときは以下のアドレスを変更してください。
    strAddress = “hanako@extan.jp”

    • ご連絡ありがとうございます。
      すみませんが、コードが切れてしまっているようで、すべての確認できませんが、
      表示されている部分は問題ないと思います。

      後考えられる要因としては、Exchange側でなにかしらの制約があるのかもしれません。
      例えばアーカイブ機能などで定期的に受信トレイ以外の別のフォルダに移しているケースなどです。
      こちらはサービス提供元の仕様にかかる内容ですので、お手数ですが担当されているところへ
      ご確認いただきたくお願いいたします。

  • とても有益な情報をありがとうございます。
    コピペしてマクロはきちんと動きましたが、以下ご相談です。
    こちらの方法は、アプリ版にダウンロードされたデータのみ取得可能となるでしょうか?
    過去に遡って(過去5年間)特定のサブフォルダからデータ取得をしたいのですが、過去1年分までしか取得できません。
    恐らくExchangeキャッシュモードでキャッシュ期間を1年に設定しているせいかと思われます。
    データ容量がオーバーしてしまう為、キャッシュ期間を5年に延ばすことは難しいです。
    この場合の解決方法がございましたらご教示いただけないでしょうか

    • いつもご利用ありがとうございます。

      データ取得の範囲が1年分となる件につきまして、ご認識の通りローカルPCのキャッシュデータをみておりますので、
      その範囲に依存する形になります。

      Exchangeから直接取得する方法につきましては、以下の記事の方法にて、アドレス部をご自身のアカウントに設定することで可能となりますので
      よろしければ、ご参考ください。
      https://extan.jp/?p=2243

  • 素晴らしい記事に感謝します。
    おかげさまで特定のメールをエクセル上で複数人で管理しやすくなりました。

    追加でもしお分かりになれば、ですが、送信者名に加えて送信者の所属部署(department)を取得する事は可能なのでしょうか。
    それとも、送信者名を取得して、それをさらに連絡先と突合させる必要があるのでしょうか。

    • いつもご利用ありがとうございます。

      送信者の所属部署を取得する方法につきまして、
      以下のユーザ情報と紐づける形で取得する方法が考えられます。

      一つ目は連絡先に登録されているユーザー情報から部署名を取得する方法になります。
      こちらの記事をご参考の上、全ユーザー情報をExcelへ出力し、Vlookup関数などで該当ユーザーの「Department」項目の情報を取得していきます。
      https://extan.jp/?p=1532

      二つ目は御社で管理してる社員マスタなど外部データを参照する方法です。
      突き合わせの方法は一つ目と同様です。

      三つ目はActive Directoryのユーザ情報を取得する方法です。
      所属するOUやADグループなどの情報を取得し、突き合わせていきます。
      Powershellコマンドを使って1件づつ突き合わせる方法がありますが、調べたいユーザが多い場合大量のリクエストをADサーバに投げる形になりますのであまりお勧めしません。
      できればこちらも情報シスなど管理部門からユーザ情報一覧をもらい受け、Excel上で突き合わせた方が良いと思われます。

  • Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込む部分ですが
    ReceivedTime は時間も持っているので
    Set olConItems = olConItems.Restrict(“[ReceivedTime] >= ‘” & strStart & “‘ And [ReceivedTime] = ‘” & strStart & “‘ And [ReceivedTime] < '" & strEnd + 1 & "'")
    ではないでしょうか

  • ご返信ありがとうございます。
    私の返信が大変遅くなり、失礼いたしました。

    申し訳ありません。勘違いしておりました。
    VBAをエクセルではなく、outlookの方に書き込んで動作させようとしていました。
    エクセルに書き込んだ所、動作しました。

    ただ、検証した所、時々スキップされているメールがありました。
    スキップされたメールは、添付ファイルも900kB程度、文字数も100文字程度でした。

    また、出力されたデータが時間順に概ね並ぶのですが、12時の前に13時のメールが来たり並びが
    完全には時間順ではありませんでした。(フィルターをかけて、並び替えすればいいのかもしれませんが、)
    これは文章の長さ等で処理の早く終わった方が追い越して記録されるのでしょうか。

    何度もすみません。
    せめて記録されないメールは無くしたいのですが、何が原因かよくわかっておりません。
    もしお心当たりがあれば、教えて下さい。
    よろしくお願いします。

    • 動いたようでよかったです。

      記録されないメールが生じてしまう件ですが、原因としては以下が考えられます。
      1.指定されている期間外に受信されたアイテムである
      2.受信日「ReceivedTime」の値がRestrictメソッドで判断できない値となっている

      まずは、以下の設定について確認いただき、入らいないメールの受信日が期間外になっていないか確認願います。
      ‘抽出期間の開始日と終了日を指定します。
      strStart = Format(“2022/2/16”, “yyyy/mm/dd”) ‘開始日を指定
      strEnd = Format(“2022/2/17”, “yyyy/mm/dd”) ‘終了日を指定

      次に、Restrictメソッドがうまく機能していない可能性もありますので、以下を無効化し(※全期間が対象となり、アイテム数が多いと処理時間がかかりますので注意してください)
      除外メールが含まれるか確認をお願いします。
      ‘Restrictメソッドで期間を指定し抽出するメールアイテムを絞り込みます。
      ‘Set olConItems = olConItems.Restrict(“[ReceivedTime] >= ‘” & strStart & “‘ And [ReceivedTime] <= '" & strEnd & "'") 並び順についてはごめんなさい、コレクションの内部ロジックの話となり詳細は分かりかねますので、 お手数ですが、Excel側でソートいただきたくお願いいたします。

  • こんにちは。VBA初心者です。
    諸事情により、Outlookメールが使えず、
    Outlook内にさくらメールのアカウントを登録して使用しています。
    この場合、上記のコードを利用してメール取得は可能でしょうか。
    下記の部分で、何かしらの指定をしなきゃいけないのかな?とは思うのですが、
    全く分からず・・・

    ‘Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの連絡先一覧を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace(“MAPI”)

    ‘既定ユーザーの受信トレイを対象にオブジェクトを取得します。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders(“サブフォルダ”)
    Set olConItems = olFolder.Items

    • いつもご利用ありがとうございます。

      さくらメールのアカウントの受信トレイのメールが取得可能かにつきまして、
      GetDefaultFolderメソッドは規定アカウントのデータファイルが対象となりますので、
      追加したアカウントとデータファイルを「規定」に設定することにより取得が可能となります。

      Outlookの「アカウント設定」より、追加したアカウントおよびデータファイルを「規定」に設定することができますので
      ご確認いただければと存じます。

  • はじめまして。
    とても便利なマクロだと思い、そのままコピペして使おうと思いました。
    すると、、

    マクロを実行すると1行目でとまります。(1行目が黄色になる)
    それと同時に、3行目が青塗りになります。
    表示されるエラーは「コンパイル エラー  ユーザー定義型は定義されていません。」

    1行目→ Sub Outlook受信メール一覧を取り込む()
    2行目→ ‘Outlook用の定義
    3行目→ Dim olApp As Outlook.Application

    そこで考えたことは、

    ・1行目のカッコに何か入れなければならない?(タイトルなので、そんな必要も無いとも思える)
    ・3行目 Outlook.Application が間違っている。(こんな名前のアプリケーションではない?)

    というのも、Office365 の中の Outlook なので、正式名称は少し違った物なのかもしれないと思ったのです。
    そこでOutlookの設定を見てみました。
    正直、よくわからなかったです。

    想像出来る範囲で教えて下さい。
    よろしくお願いします。

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

    CAPTCHA ImageChange Image