将每日展望日历导出到Excel VBA

Question

在下面的代码中，我编写并在开始日期和结束日期之间得到输出，但是我希望一天的所有会议以前都没有在给定的开始日期和结束日期之间进行。

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 = CDate("08/25/2017")
    'ToDate = CDate("12/31/2017")

    FromDate = Format(InputBox("Enter Start Date(dd/mm/yyyy)", , Date), "dd/mm/yyyy")
    ToDate = Format(InputBox("Enter Start Date(dd/mm/yyyy)", , DateAdd("d", 7, Date)), "dd/mm/yyyy")

    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("Project", "StartDate", "EndDate", "Time spent", "Location")
        For Each olApt In olFolder.Items
            If (olApt.Start >= FromDate And olApt.End <= ToDate) Then
                .Cells(NextRow, "A").Value = olApt.Subject
                .Cells(NextRow, "B").Value = CDate(olApt.Start)
                .Cells(NextRow, "C").Value = CDate(olApt.End)
                .Cells(NextRow, "D").Value = olApt.End - olApt.Start
                .Cells(NextRow, "D").NumberFormat = "HH:MM:SS"
                .Cells(NextRow, "E").Value = olApt.Location
                .Cells(NextRow, "F").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

我每天都需要所有会议数据。如果会议是事先安排的。