Получить массив дат между 2 датами

Question

Мне нужна помощь в создании массива дат между 2 датами. Я пытаюсь экспортировать праздники из календаря MS Project, используя объект Исключения. Однако каждое исключение Calendar.Exception не является отдельной датой. Их можно определить как диапазон дат (например, рождественские каникулы).

Sub ArrayOfDates()
    Dim StartDate As Date, EndDate As Date, aDates() As Date
    StartDate = #1/1/2018#
    EndDate = #1/31/2018#

    'create array of dates inclusive of endpoints
    If EndDate > StartDate Then

    End If

End Sub

Спасибо за все предложения. Я пошел с подходом, который устранил массив:

Sub ExportCalendarHolidays()
    Dim calThisPrjCalendar As Calendar, excPeriod As Exception, OutputFileName As String, sOutputLine As String
    Dim Period As Date

    Set calThisPrjCalendar = ActiveProject.Calendar

    OutputFileName = ActiveProject.Path & "\" & "Holidays_" & Format(Now(), "yyyy-mm-dd_hhmmss") & ".csv"
    Open OutputFileName For Output As #1

    For Each excPeriod In calThisPrjCalendar.Exceptions
        For Period = excPeriod.Start To excPeriod.Finish
            sOutputLine = Format(Period, "mm/dd/yyyy")
            Print #1, sOutputLine
        Next Period
    Next

    'Cleanup
    Close #1
End Sub

Answer 1

Приведенный ниже код создаст массив, включающий дату начала и окончания. Строки, помеченные как Debug, могут быть удалены. Цикл в конце просто проверяет даты.

Редактировать: отредактированный конечный цикл выглядит лучше.

Sub ArrayOfDates()
    Dim StartDate As Date, EndDate As Date, aDates() As Date
    Dim x As Long, y As Long, totalDates As Integer
    StartDate = #1/1/2018#
    EndDate = #1/31/2018#
    DateLoop = StartDate
    totalDates = DateDiff("d", StartDate, EndDate)
    ReDim aDates(totalDates)
    x = 0
    Do While DateLoop <= EndDate
        aDates(x) = DateLoop
        Cells(x + 1, 1).Value = DateLoop ' Debug Line
        DateLoop = DateAdd("d", 1, DateLoop)
        x = x + 1
    Loop
    For y = 0 To UBound(aDates)
        Cells(y + 1, 3).Value = aDates(y) ' Debug Line
        Cells(y + 1, 4).Value = "Array Spot: " & y 'Debug Line
    Next y
End Sub

Answer 2

Чтобы просто получить все даты, вы можете сделать что-то вроде.

Dim dtDate as Date, dtStartDate as date, dtEndDate as Date

dtStartDate = #1/1/2018#
dtEndDate = #1/31/2018#

For dtDate = dtStartDate To dtEndDate
    'code to do each date
Next dtDate