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

Sub ExportSubfolderEmailsByDateAndTimeToExcel()
    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 startTimeStr As String
    Dim endTimeStr As String
    
    ' Prompt the user to enter the start date and time and end date and time.
    startTimeStr = InputBox("Enter start date and time (yyyy-mm-dd hh:mm:ss):")
    endTimeStr = InputBox("Enter end date and time (yyyy-mm-dd hh:mm:ss):")
    
    ' Convert the user-input date and time strings to Date objects.
    On Error Resume Next
    startDate = CDate(startTimeStr)
    endDate = CDate(endTimeStr)
    On Error GoTo 0
    
    If startDate = 0 Or endDate = 0 Then
        MsgBox "Invalid date and time format. Please use yyyy-mm-dd hh:mm:ss 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