Использование 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-коду (изменен нажатием кнопки submit). Кто-нибудь может предложить какие-либо предложения?

'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 

Edit:

После анализа запросов 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

Я играл с последним, и для каждого цикла в следующем цикле должен идти после него. Затем я сделал список в sheet1, и он сработал. Я сделал несколько небольших настроек, таких как добавление переменной для увеличения ячеек.

Этот код не привел к фактическим результатам только на веб-сайтах, не уверен, что это то, к чему вы стремились.