代码之家 › 专栏 › 技术社区 › Error 1004

用VBA从HTML日期选择器中选择日期

web-scraping vba html

1

Error 1004 · 技术社区 · 7 年前

下面的代码,我试图改变日期选择器日期,但我收到一个错误。如果你能提供任何解决方案/纠正措施,我会很高兴的。

@我试着在几个月前仿效你的例子。

Sub Download_Historical_Data()

Dim DateToUse As String, ChampionName As String

Dim IE As InternetExplorer, doc As HTMLDocument, games As Object
Dim i As Long, j As Long

'Loop until you reach the day before today
Do Until wsControl.Range("B1").Value = Format$(Date - 1, "DD-MM")
    'Initialize project. Check the LastDate and if it is null we use "2018 - 01 - 01" and import the it in wsControl.Range("B1").Value
    If wsControl.Range("B1").Value = "" Then
        DateToUse = Format$("01-01-2018", "DD-MM")
        wsControl.Range("B1").Value = DateToUse
    Else
        DateToUse = Format(wsControl.Range("B1").Value + 1, "DD-MM")
    End If

    'Open Browser and download data
    Set IE = New InternetExplorer

    With IE
        .Visible = True
        .Navigate ("https://www.xscores.com/soccer/livescores/" & DateToUse)

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

        Set doc = .document

    End With

    Set games = doc.getElementsByClassName("game_table")

    IE.Quit
    Set IE = Nothing

Loop

End Sub

1 回复 | 直到 7 年前

1

QHarr 7 年前

长方法:

这篇文章通过单击月份(向后箭头)和日期(通过在日历中循环日期并选择适当的日期)来导航

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

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手动选择日期(顶行):

2018-09-19代码运行结果:

一轮一轮:

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