Выберите дату из HTML datepicker с VBA

Длинный метод:

Эта часть перемещается, щелкая по месяцам (стрелка назад) и датам (циклически перебирая даты в календаре и выбирая подходящую дату).

Вы можете выбрать даты только за 2 недели до текущей даты в соответствии с дизайном веб-сайта. Я добавил хитрость, чтобы обойти это в самом конце, что делает элемент доступным для выбора, но, к сожалению, любая дата раньше, чем за две недели до этого, по умолчанию будет возвращать данные последней даты.

Option Explicit  
Public Sub DateSelection()
    'Max past date is 2 weeks prior to today's date
    Dim dateToUse As String, lastSundayPriorMonth As Long, numberOfIndicesToIgnore As Long
    dateToUse = "2018-09-28"

    If Not IsDateValid(dateToUse) Then
        MsgBox "Please select a date between " & Format$(DateAdd("ww", -2, Date) + 1, "yyyy-mm-dd") & " and " & Format$(Date, "yyyy-mm-dd")
        Exit Sub
    End If

    lastSundayPriorMonth = GetLastSunday(DateAdd("m", -1, CDate(dateToUse)))
    numberOfIndicesToIgnore = Abs(CDate(dateToUse) - lastSundayPriorMonth) '<==Dates from prior month to ignore on displayed calendar

    Dim dates As Object, ie As InternetExplorer, i As Long
    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .navigate "https://www.xscores.com/soccer/livescores"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document

            Dim numberOfMonthsInPast As Long

            numberOfMonthsInPast = GetNumberOfMonthsBack(dateToUse)

            .querySelector(".dateDetails").Click

            If numberOfMonthsInPast > 0 Then               
                For i = 1 To numberOfMonthsInPast 'navigate back the required number of months
                    .querySelector(".calendar-prev").Click
                    While ie.Busy Or ie.readyState < 4: DoEvents: Wend
                Next
            End If

            Set dates = .querySelectorAll(".calendar-dates [class^=date]") '<== All dates in selected month view

            For i = numberOfIndicesToIgnore To dates.Length - 1
                If CInt(dates.item(i).innerText) = Day(dateToUse) Then
                    dates.item(i).querySelector("a").Click 
                    While ie.Busy Or ie.readyState < 4: DoEvents: Wend
                    Exit For
                End If
            Next
            'other code
        End With
        Stop                                     '<==Delete me later
        .Quit
    End With
End Sub

Public Function GetLastSunday(ByVal dateString As String) As Long
    Dim d As Date
    d = DateSerial(YEAR(dateString), Month(dateString) + 1, 1) - 1
    GetLastSunday = d - Weekday(d) + 1
End Function

Public Function IsDateValid(ByVal dateString As String) As Boolean
    IsDateValid = (DateDiff("ww", dateString, Date) >= 0 And DateDiff("ww", dateString, Date) <= 2)
End Function

Public Function GetNumberOfMonthsBack(ByVal dateString As String) As Long
    GetNumberOfMonthsBack = DateDiff("m", dateString, Date)
End Function

Предпочтительно:

Мне кажется, что я все еще могу получить более старые даты, просто используя dd-mm в URL-адресе, но я ценю, что это дает вам переменные результаты (часто по умолчанию используются последние данные).

Option Explicit
Public Sub test()
    Dim ie As New InternetExplorer
    With ie
        .Visible = True
        .navigate "https://www.xscores.com/soccer/livescores/19-09"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Stop '<== Delete me later
        .Quit
    End With
End Sub

Данные за сегодня 2018-10-03 (верхние строки):

Дата ручного выбора на 2018-09-19 (верхние строки):

Результат выполнения кода за 19.09.2018:

Взломать:

Option Explicit
Public Sub DateSelection()
    'Max past date is 2 weeks prior to today's date
    Dim dateToUse As String, lastSundayPriorMonth As Long, numberOfIndicesToIgnore As Long
    dateToUse = "2018-09-18"

    lastSundayPriorMonth = GetLastSunday(DateAdd("m", -1, CDate(dateToUse)))
    numberOfIndicesToIgnore = Abs(CDate(dateToUse) - lastSundayPriorMonth) '<==Dates from prior month to ignore on displayed calendar

    Dim dates As Object, ie As InternetExplorer, i As Long
    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .navigate "https://www.xscores.com/soccer/livescores"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document

            Dim numberOfMonthsInPast As Long

            numberOfMonthsInPast = GetNumberOfMonthsBack(dateToUse)

            .querySelector(".dateDetails").Click

            If numberOfMonthsInPast > 0 Then
                For i = 1 To numberOfMonthsInPast 'navigate back the required number of months
                    .querySelector(".calendar-prev").Click
                    While ie.Busy Or ie.readyState < 4: DoEvents: Wend
                Next
            End If

            Set dates = .querySelectorAll(".calendar-dates [class^=date]") '<== All dates in selected month view

            For i = numberOfIndicesToIgnore To dates.Length - 1
                If CInt(dates.item(i).innerText) = Day(dateToUse) Then
                    If Not IsDateWithin2Weeks(dateToUse) Then
                        With dates.item(i)
                            .outerHTML = Replace(dates.item(i).outerHTML, " disabled", vbNullString)
                            Set dates = ie.document.querySelectorAll(".calendar-dates [class^=date]") '<== All dates in selected month view
                        End With
                    End If
                    dates.item(i).querySelector("a").Click

                    While ie.Busy Or ie.readyState < 4: DoEvents: Wend
                    Exit For
                End If
            Next
            'other code
        End With
        Stop                                     '<==Delete me later
        .Quit
    End With
End Sub

Public Function IsDateWithin2Weeks(ByVal dateString As String) As Boolean
    IsDateWithin2Weeks = (DateDiff("ww", dateString, Date) >= 0 And DateDiff("ww", dateString, Date) <= 2)
End Function