Outlookのサブフォルダーの日付を指定してExcelシートに出力

Question

outlookのサブフォルダーの特定の日付をExcelシートに出力したいです

現在サブフォルダーのみでしたら取得ができています

Set subFolder = objIndex.Folders(“サブフォルダー”)

For i = 1 to subFolder.Items.Count
If subFolder.Item.class = 43 Then
Cells(i + 1,1).value =subFolder.Item(i).SenderName
Cells(i + 1, 2).value =subFolder.Item(i).Subject
Cells(i + 1, 3).value =subFolder.Item(i).ReceivedTim
Cells(i + 1, 4).value =subFolder.Item(i).Body
End if
Next

これに何を
何を追加したら日付を指定して取得できしょうか
お願いします

Comments

[sk.exe]

> outlookのサブフォルダーの特定の日付

> If subFolder.Item.class = 43 Then

あるフォルダに格納されている「MailItem オブジェクトの」、ということまでは推定できますが、「特定の日付」というのが具体的に何に関する日付（日時）を意味しているのかが不明です。

例えば「受信トレイの任意のフォルダに格納されている全ての受信メールの受信日時を取得したい」といったことなのであれば、その旨を明記されることをお奨めします。

> Cells(i + 1, 3).value =subFolder.Item(i).ReceivedTim

あとこのプロパティは「ReceivedTime」が正しい名前でしょう。
（末尾の e が抜けている）

[Kumo]

回答ありがとうございます
サブフォルダー内にある日付
全部取得したいわけではなく1/17日分だけ取得といった感じです
別日には1/18日分を取得できるようにできればいいなと思っております

プロパティのeが抜けてる件
ご指摘ありがとうございます。

Answer 1

全部取得したいわけではなく1/17日分だけ取得といった感じです
別日には1/18日分を取得できるようにできればいいなと思っております

「受信日時が昨日である（現在のシステム日付の前日の 0:00 から 23:59 までの範囲に含まれる）メールのみをリストアップしたい」ということなのであれば、例えば次のようなコードを実行なさればよろしいでしょう。

Sub OutputReceivedMailsFromOutlook()
On Error GoTo Err_OutputReceivedMailsFromOutlook
  
    Const olFolderInbox = 6
  
    Dim olApp As Object         'Outlook.Application
    Dim blCreateApp As Boolean
      
    blCreateApp = False
    On Error Resume Next
    '実行中の Outlook アプリケーションの参照
    Set olApp = GetObject(, "Outlook.Application")
    '参照できなかった場合
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo Err_OutputReceivedMailsFromOutlook
        'Outlook アプリケーションの新規インスタンスの生成
        Set olApp = CreateObject("Outlook.Application")
        'アプリケーション起動フラグを True に
        blCreateApp = True
    End If
    On Error GoTo Err_OutputReceivedMailsFromOutlook
     
    Dim olNamespace As Object       'Outlook.Namespace
    Dim olInBoxFolder As Object     'Outlook.Folder
    Dim olTargetFolder As Object    'Outlook.Folder
    Dim olMailItems As Object       'Outlook.Items
     
    '受信トレイの参照
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olInBoxFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    
    '受信トレイ内のフォルダの参照
    Set olTargetFolder = olInBoxFolder.Folders("フォルダー名")
    'フォルダ内のメールアイテムコレクションの参照
    Set olMailItems = olTargetFolder.Items
   
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lngRow As Long
      
    '新規ブックの作成
    Set wbBook = Workbooks.Add
    'その1つめのワークシートの参照
    Set wsSheet = wbBook.Worksheets(1)
    '出力先行番号を1から開始
    lngRow = 1
      
    'ワークシートの列見出しの設定
    With wsSheet
        .Cells(lngRow, 1).Value = "差出人の表示名"
        .Cells(lngRow, 2).Value = "件名"
        .Cells(lngRow, 3).Value = "受信日時"
        .Cells(lngRow, 4).Value = "本文"
    End With
    
    Dim dtStartDate As Date
    Dim dtEndDate As Date
    Dim strStartDate As String
    Dim strEndDate As String
    Dim strFilter As String
    Dim lngHitCount As Long
    Dim olMailItem As Object        'Outlook.MailItem
    
    '日時範囲の開始日時を指定
    dtStartDate = DateAdd("d", -1, Date)
    '日時範囲の終了日時を指定
    dtEndDate = DateAdd("s", -1, DateAdd("d", 1, Date))

    '受信日時に対する検索条件式の生成
    strStartDate = Format(dtStartDate, "ddddd h:nn AMPM")
    strEndDate = Format(dtEndDate, "ddddd h:nn AMPM")
    strFilter = "[ReceivedTime] >= """ & strStartDate & """ AND [ReceivedTime] <= """ & strEndDate & """"
    '検索条件式をイミディエイトウィンドウに出力（デバッグ用）
    Debug.Print strFilter

    'ヒットカウンタの初期化
    lngHitCount = 0
    
    '条件に該当する最初のアイテムを検索
    Set olMailItem = olMailItems.Find(strFilter)
    
    'ヒットしなくなくなるまでループ
    Do Until olMailItem Is Nothing
        'ヒットカウンタのインクリメント
        lngHitCount = lngHitCount + 1
        '出力先行番号のインクリメント
        lngRow = lngRow + 1
        '各プロパティの値をワークシートの各列に書き出す
        wsSheet.Cells(lngRow, 1).Value = olMailItem.SenderName
        wsSheet.Cells(lngRow, 2).Value = olMailItem.Subject
        wsSheet.Cells(lngRow, 3).Value = olMailItem.ReceivedTime
        wsSheet.Cells(lngRow, 4).Value = olMailItem.Body
        '次のアイテムを検索
        Set olMailItem = olMailItems.FindNext
    Loop
     
    'ワークシートの列幅の自動調整
    wsSheet.UsedRange.EntireColumn.AutoFit
     
    'ヒット件数をメッセージボックスに表示
    MsgBox "ヒットしたメールアイテムは " & lngHitCount & " 件です。", _
           vbInformation, _
           "検索完了"
     
Exit_OutputReceivedMailsFromOutlook:
On Error Resume Next
     
    Set olMailItem = Nothing
    Set olMailItems = Nothing
    Set olTargetFolder = Nothing
    Set olInBoxFolder = Nothing
    Set olNamespace = Nothing
    'このプロシージャによって Outlook が起動された場合
    If blCreateApp Then
        'Outlook の終了
        olApp.Quit
    End If
    Set olApp = Nothing
     
    Set wsSheet = Nothing
    Set wbBook = Nothing
     
    Exit Sub
     
Err_OutputReceivedMailsFromOutlook:
     
    MsgBox Err.Number & ": " & Err.Description, _
           vbCritical, _
           "実行時エラー(OutputReceivedMailsFromOutlook)"
          
    Resume Exit_OutputReceivedMailsFromOutlook
End Sub

Comments

[Kumo]

ありがとうございます
早速やってみます❗️