Outlook VBAで受信メールのサブフォルダ内のメールを日付指定で抽出してExcelに出力させる方法

Sub ExportSubfolderEmailsByDateToExcel()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olSubfolder As Object
    Dim olMailItem As Object
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlWS As Object
    Dim iRow As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim startDateStr As String
    Dim endDateStr As String
    
    ' Prompt the user to enter the start and end dates in a specific format (e.g., "yyyy-mm-dd").
    startDateStr = InputBox("Enter start date (yyyy-mm-dd):")
    endDateStr = InputBox("Enter end date (yyyy-mm-dd):")
    
    ' Convert the user-input date strings to Date objects.
    On Error Resume Next
    startDate = CDate(startDateStr)
    endDate = CDate(endDateStr)
    On Error GoTo 0
    
    If startDate = 0 Or endDate = 0 Then
        MsgBox "Invalid date format. Please use yyyy-mm-dd format."
        Exit Sub
    End If
    
    ' Outlook application and namespace
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' Specify the subfolder within the Inbox to search
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6 represents the Inbox
    
    ' Specify the name of the subfolder (e.g., "Subfolder Name")
    Set olSubfolder = olFolder.Folders("Subfolder Name")
    
    ' Create an Excel application and workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    
    ' Add headers in Excel
    xlWS.Cells(1, 1).Value = "Received Date"
    xlWS.Cells(1, 2).Value = "Sender"
    xlWS.Cells(1, 3).Value = "Subject"
    xlWS.Cells(1, 4).Value = "Body"
    
    ' Row counter
    iRow = 2
    
    ' Loop through emails in the subfolder
    For Each olMailItem In olSubfolder.Items
        If olMailItem.Class = 43 And olMailItem.ReceivedTime >= startDate And olMailItem.ReceivedTime <= endDate Then
            xlWS.Cells(iRow, 1).Value = olMailItem.ReceivedTime
            xlWS.Cells(iRow, 2).Value = olMailItem.SenderName
            xlWS.Cells(iRow, 3).Value = olMailItem.Subject
            xlWS.Cells(iRow, 4).Value = olMailItem.Body
            iRow = iRow + 1
        End If
    Next olMailItem
    
    ' Save the Excel file (optional)
    'xlWB.SaveAs "C:\Path\To\Your\Excel\File.xlsx"
    
    ' Close the Excel workbook and application (optional)
    'xlWB.Close
    'xlApp.Quit
    
    ' Release memory and close Outlook
    Set olApp = Nothing
End Sub