代码未检索指定期间内的所有约会

Question

我已经改编了代码，以便将Outlook日历导出到Excel.csv文件。导出应仅提取由InputBoxes输入的指定时间间隔的“主题”，“开始日期”，“结束日期”和“类别”字段。有些事件可能是周期性的，有些则是每周一次。

我试图修改代码，这是Excel中的宏，它将把Outlook日历中的数据复制到空白文件中。

Option Explicit

Sub ListAppointments()
    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim olApt As Object
    Dim NextRow As Long
    Dim FromDate As Date
    Dim ToDate As Date

   FromDate = InputBox("Enter the start date (format: yyyy/mm/dd)")
   ToDate = InputBox("Enter the end date(format: yyyy/mm/dd)")

    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0

    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
    NextRow = 2

    With Sheets("Sheet1") 'Change the name of the sheet here
        .Range("A1:D1").Value = Array("Subject", "Start Date", "End Date", "Category")
        For Each olApt In olFolder.Items
            If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
                .Cells(NextRow, "A").Value = olApt.Subject
                .Cells(NextRow, "B").Value = CDate(olApt.Start)
                .Cells(NextRow, "C").Value = CDate(olApt.End)
                .Cells(NextRow, "C").NumberFormat = "dd.mm.yyyy hh:mm"
                .Cells(NextRow, "D").Value = olApt.Categories
                NextRow = NextRow + 1
            Else
            End If
        Next olApt
        .Columns.AutoFit
    End With

    Set olApt = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub

我希望在指定的时间间隔内将日历中的约会提取（复制）到空白的Excel文件中。