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

Use VBA to click html button and then scrape refreshed data

提问by user3725021

I am trying to write a procedure which enters a date into an input box

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

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

clicks a submit button

单击提交按钮

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

then scrapes the resulting data, which appears in the "a" tags.

然后抓取出现在“a”标签中的结果数据。

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

This data is not available until the submit button has been entered. My attempt is posted in full below. The problem I seem to be having is that i am not able to access the modified html code (modified by clicking submit). Can anyone provide any suggestions?

在输入提交按钮之前，此数据不可用。我的尝试在下面完整发布。我似乎遇到的问题是我无法访问修改后的 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

采纳答案by silentsurfer

Insert a condition to wait while the page is loading.

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

The following rewrite successfully fetches data from the target page on my pc:

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

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

Edit:

编辑：

After analyzing the HTTP requests I managed to slim down the code a little bit (results can be queried directly without filling the form and submitting the page)

分析完HTTP请求后，我设法将代码精简了一点（结果可以直接查询，无需填写表单和提交页面）

I am not a huge fan of expensive array ReDims, so I created a class instead, and save the results in a collection of that class (feel free to use it or not).

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

Add a new class module, call it clRaceMeet and paste this code:

添加一个新的类模块，将其命名为 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

Then, use this modified code version to scrape the data and dump it to the debugging window:

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

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

Happy betting! :)

投注愉快！:)

回答by EL Montgomery

I toyed around with the last one and the for each loop within the for next loop has to go after it. I then also made it list into sheet1 and it worked. I did a few minor adjustments such as adding a variable to increment the cells.

我玩弄了最后一个，for 下一个循环中的每个循环都必须在它之后。然后我也把它列在 sheet1 中并且它起作用了。我做了一些小的调整，比如添加一个变量来增加单元格。

this code didn't produce the actual results just the websites, not sure if that is what you were aiming for.

这段代码并没有产生网站的实际结果，不确定这是否是你的目标。