使用VBA单击html按钮，然后抓取刷新的数据

Question

我正在尝试编写一个在输入框中输入日期的过程

<input name="Mdate" type="text" id="Mdate" size="30" value="" /></td>

单击"提交"按钮

<input type="submit" name="button" id="button" value="Submit" />

然后抓取结果数据，这些数据显示在"a"标签中。

<center>
<b>Tuesday, 6 January 2015</b><br />
<a href="/horse-racing-results/Ruakaka/2015-1-6" target="_blank">Ruakaka</a>

在输入提交按钮之前，此数据不可用。我的尝试全文发布在下面。我似乎遇到的问题是我无法访问修改后的 html 代码（通过单击提交进行修改）。任何人都可以提供任何建议吗？

'dimension variables
Dim ie As InternetExplorer
Dim htmldoc As MSHTML.IHTMLDocument                                                         'Document object
Dim inputs As MSHTML.IHTMLElementCollection                                                 'Element collection for "input" tags
Dim eles1, eles2 As MSHTML.IHTMLElementCollection                                            'Element collection for th tags
Dim element As MSHTML.IHTMLElement                                                          'input elements
Dim ele1, ele2 As MSHTML.IHTMLElement                                                       'Header elements
'Open InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False                                                                          'make IE invisible
'Navigate to webpage
Dim ieURL As String:    ieURL = "http://www.racenet.com.au/horse-racing-results/"           'set URL from which to retrieve racemeet and date data
ie.navigate ieURL                                                                           'navigate to URL
Do While ie.Busy Or ie.readyState <> 4                                                      'wait for page to load
    DoEvents
Loop
Set htmldoc = ie.document                                                                   'Document webpage
Set inputs = htmldoc.getElementsByTagName("input")                                          'Find all input tags
Dim dd, mm, yyyy As Integer
Dim startdate, enddate As Date
Dim i, j, k As Long
Dim raceMeet, raceURL As String
startdate = #1/1/2008#: enddate = Date - 1
Dim racemeetArr As Variant
ReDim racemeetArr(1 To 2, 1)
For i = startdate To enddate
    dd = Day(i): mm = Month(i): yyyy = Year(i)
    For Each element In inputs
        If element.Name = "Mdate" Then
            element.Value = yyyy & "-" & mm & "-" & dd
        Else
            If element.Name = "button" Then
                element.Click
                'insert scraper
                Set eles1 = htmldoc.getElementsByTagName("a")                                          'Find all centre tags
                    For Each ele1 In eles1
                        If InStr(ele1.href, "/horse-racing-results/") > 0 Then
                            raceMeet = ele1.innerText
                            raceURL = ele1.innerHTML
                            ReDim Preserve racemeetArr(1 To 2, UBound(racemeetArr, 2) + 1)
                            racemeetArr(1, UBound(racemeetArr, 2)) = raceMeet
                            racemeetArr(2, UBound(racemeetArr, 2)) = raceURL
                        End If
                    Next ele1
            Else
            End If
        End If
    Next element
Stop
Next i
ie.Quit

Answer 1

插入一个条件，以便在页面加载时等待。

以下重写成功从我电脑上的目标页面获取数据：

Private Sub CommandButton1_Click()
    'dimension variables
    Dim ie As InternetExplorer
    Dim htmldoc As MSHTML.IHTMLDocument                                                         'Document object
    Dim inputs As MSHTML.IHTMLElementCollection                                                 'Element collection for "input" tags
    Dim eles1, eles2 As MSHTML.IHTMLElementCollection                                            'Element collection for th tags
    Dim element As MSHTML.IHTMLElement                                                          'input elements
    Dim ele1, ele2 As MSHTML.IHTMLElement                                                       'Header elements
    'Open InternetExplorer
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True                                                                          'make IE invisible
    'Navigate to webpage
    Dim ieURL As String:    ieURL = "http://www.racenet.com.au/horse-racing-results/"           'set URL from which to retrieve racemeet and date data
    ie.navigate ieURL                                                                           'navigate to URL
    Do While ie.Busy Or ie.readyState <> 4                                                      'wait for page to load
        DoEvents
    Loop
    Set htmldoc = ie.document                                                                   'Document webpage
    Set inputs = htmldoc.getElementsByTagName("input")                                          'Find all input tags
    Dim dd, mm, yyyy As Integer
    Dim startdate, enddate As Date
    Dim i, j, k As Long
    Dim raceMeet, raceURL As String
    startdate = #1/1/2008#: enddate = Date - 1
    Dim racemeetArr As Variant
    ReDim racemeetArr(1 To 2, 1)
    For i = startdate To enddate
        dd = Day(i): mm = Month(i): yyyy = Year(i)

        For Each element In inputs
            If element.Name = "Mdate" Then
                element.Value = yyyy & "-" & mm & "-" & dd
            Else
                If element.Name = "button" Then
                    element.Click
                    Exit For
                End If
            End If
        Next element

        Do
        ' Wait until the Browser is loaded'
        Loop Until ie.readyState = READYSTATE_COMPLETE
        'insert scraper
        Set eles1 = htmldoc.getElementsByTagName("a")                                          'Find all centre tags
            For Each ele1 In eles1
                If InStr(ele1.href, "/horse-racing-results/") > 0 Then
                    raceMeet = ele1.innerText
                    raceURL = ele1.innerHTML
                    ReDim Preserve racemeetArr(1 To 2, UBound(racemeetArr, 2) + 1)
                    racemeetArr(1, UBound(racemeetArr, 2)) = raceMeet
                    racemeetArr(2, UBound(racemeetArr, 2)) = raceURL
                End If
            Next ele1
        Stop
    Next i
    ie.Quit
End Sub

编辑：

在分析了HTTP请求之后，我设法精简了代码（可以直接查询结果，而无需填写表格并提交页面）

我不是昂贵的数组 ReDims 的忠实粉丝，所以我创建了一个类，并将结果保存在该类的集合中（随意使用它或不使用它）。

添加新的类模块，命名为 clRaceMeet 并粘贴以下代码：

Option Explicit
Private pMeet As String
Private pUrl As String

Public Property Let Meet(ByVal Val As String)
    pMeet = Val
End Property
Public Property Get Meet() As String
    Meet = pMeet
End Property
Public Property Let URL(ByVal Val As String)
    pUrl = Val
End Property
Public Property Get URL() As String
    URL = pUrl
End Property

然后，使用此修改后的代码版本抓取数据并将其转储到调试窗口：

Option Explicit
Private Sub CommandButton1_Click()
    'dimension variables
    Dim ie As InternetExplorer
    Dim ieURL As String
    Dim dd As Integer
    Dim mm As Integer
    Dim yyyy As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim i As Long
    Dim htmlDoc As MSHTML.IHTMLDocument
    Dim colLeftEleColl As MSHTML.IHTMLElementCollection
    Dim colLeftEle As MSHTML.IHTMLElement
    Dim centerEleColl As MSHTML.IHTMLElementCollection
    Dim centerEle As MSHTML.IHTMLElement
    Dim raceMeet As String
    Dim raceURL As String
    Dim objRaceMeet As clRaceMeet
    Dim raceMeetColl As New Collection

    'Open InternetExplorer
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    startDate = #1/1/2009#
    endDate = Date - 1
    For i = startDate To endDate
        dd = Day(i)
        mm = Month(i)
        yyyy = Year(i)
        ieURL = "http://www.racenet.com.au/horse-racing-results-search.asp?Mdate=" & yyyy & "-" & mm & "-" & dd
        ie.navigate ieURL
        Do
        ' Wait until the Browser is loaded'
        Loop Until ie.readyState = READYSTATE_COMPLETE
        Set htmlDoc = ie.document
        'insert scraper
        Set colLeftEleColl = htmlDoc.getElementById("ColLeft").all
        'Loop through elements of ColLeft div
        For Each colLeftEle In colLeftEleColl
            If colLeftEle.tagName = "CENTER" Then
                Set centerEleColl = colLeftEle.all
                'Loop through elements of <center> tag
                For Each centerEle In centerEleColl
                    If centerEle.tagName = "A" Then
                        If InStr(centerEle.href, "/horse-racing-results/") > 0 Then
                            raceMeet = centerEle.innerText
                            raceURL = centerEle.href
                            Set objRaceMeet = New clRaceMeet
                            objRaceMeet.Meet = raceMeet
                            objRaceMeet.URL = raceURL
                            raceMeetColl.Add objRaceMeet
                        End If
                    End If
                Next centerEle
                Exit For
            End If
        Next colLeftEle
        ' Dump results to immediate window:
        For Each objRaceMeet In raceMeetColl
            Debug.Print objRaceMeet.Meet & " - " & objRaceMeet.URL
        Next objRaceMeet
        'Stop
    Next i
    ie.Quit
End Sub

祝您投注愉快！ :)

Answer 2

我玩弄了最后一个，下一个循环中的每个循环都必须追逐它。然后我也把它列在工作表 1 中，它起作用了。我做了一些小的调整，例如添加一个变量来增加单元格。

此代码没有仅对网站产生实际结果，不确定这是否是您的目标。