Question

我正在尝试使用VBA导航到网页，填写一些信息，单击按钮，移动到下一页，并收集一些结果信息。这是我遇到的问题：代码完成了前几个步骤，但是当它尝试解析第二个页面的html时，它会从第一页返回HTML。出于某种原因，即使屏幕上显示正确的页面（包含所需信息），WebBrowser.Document中的HTML也不会随着新屏幕加载而改变。我试过强迫I.E.等到页面加载，但这似乎没有任何区别。代码如下：

    Sub SnowLoad(Latitude As String, Longitude As String, State As String)


Dim MyHTML_Element As IHTMLElement
Dim HTMLDoc As HTMLDocument
Dim MyURL As String
Dim SnowTag As String
Dim SnowPos As Long
SnowTag = "Load"
On Error GoTo Err_Clear
MyURL = "http://snowload.atcouncil.org/"
''open new explorer
Dim MyBrowser As New InternetExplorer
MyBrowser.Silent = True
''navigate to page
MyBrowser.navigate MyURL
MyBrowser.Visible = True
''wait until ready
Do
DoEvents
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE

Set HTMLDoc = MyBrowser.document
HTMLDoc.all.optionCoordinate_LATLON.Click

HTMLDoc.all.coordinate_lat.Value = Latitude
HTMLDoc.all.coordinate_lon.Value = Longitude
Set elems = HTMLDoc.getElementsByTagName("button")
    For Each e In elems

        If (e.getAttribute("class") = "btn") Then
            e.Click
            Exit For
        End If

    Next e

Do
DoEvents
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE

Set elems = HTMLDoc.getElementsByTagName("p")

    For Each e In elems
        Debug.Print e.innerHTML
        If InStr(e.innerHTML, SnowTag) Then
            SnowPos = InStr(e.innerHTML, SnowTag)
            Range("SnowPosition").Value = SnowPos
            Exit For
        End If

    Next e

Err_Clear:
 If Err <> 0 Then
 Err.Clear
 Resume Next
 End If

End Sub

我为我的生活无法弄清楚如何获得第二页上显示的信息。没有任何谷歌搜索似乎产生了答案或类似的问题。是否与使用按钮导航代替对.navigate的实际调用有关？

Answer 1

我的工作看似可靠。我只跑了5-6次没有问题。页面刷新后我也没找到元素。为了解决这个问题，我在加载后得到了一个全新的对象引用。这似乎运作良好。

另外，我对代码进行了全面清理。

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub SnowLoad()
On Error GoTo errhand:
    'I hard coded these for testing
    Latitude = "46"
    Longitude = "-87"

    Dim MyURL       As String: MyURL = "http://snowload.atcouncil.org/"
    Dim element     As Object

    ''open new explorer, I used late binding
    Dim MyBrowser   As Object: Set MyBrowser = CreateObject("InternetExplorer.Application")
    MyBrowser.Visible = True
    MyBrowser.navigate MyURL

    'Wait for the browser to finish loading
    waitForLoad MyBrowser

    With MyBrowser.document
        .getElementByID("optionCoordinate_LATLON").Click
        .getElementByID("coordinate_lat").Value = Latitude
        .getElementByID("coordinate_lon").Value = Longitude
        .getElementsByName("btn-submit")(0).Click
    End With

    waitForLoad MyBrowser

    'For whatever reason the HTML isn't updating along with the page
    'Instead, I'm just getting an updated reference to the IE object with the
    'below function, weird issue, but this seems to work
    Set MyBrowser = FindWindow("component/vcpsnowload/item")
    Set element = MyBrowser.document.Forms("adminForm").getelementsByTagName("p")(0)
    Range("A1").Value = element.innertext

    Exit Sub
errhand:
    MsgBox (Err.Number & "  " & Err.Description)
End Sub

Public Function FindWindow(SearchCriteria As String) As Object
    Dim window As Object

    For Each window In CreateObject("Shell.Application").Windows
        If window.locationurl Like "*" & SearchCriteria & "*" Then
            Set FindWindow = window
            Exit Function
        End If
    Next

    Set FindWindow = Nothing
End Function

Public Sub waitForLoad(ByVal IE As Object)
    Dim i As Byte
    Sleep 500 ' wait a bit for the page to start loading
    Do
        i = i + 1
        Sleep 500
    Loop Until IE.readystate = 4 Or IE.busy = False Or i >= 20
End Sub

上面的代码返回：Any elevation: Ground Snow Load is 60 psf

VBA：通过单击从页面导航HTML数据

1 个答案: