Question

我有一些可以正常工作的Web自动化。但是，我正在寻找一种更清洁的方法（如果存在）来暂停处理，直到完成网页构建为止。

我看到其他人如何使用 Do While IE.Busy: DoEvents: Loop 要么 Do Until IE.ReadyState = 4: DoEvents: Loop。

这两个似乎都不在每次运行代码时都起作用。看来，如果网络运行缓慢，就会陷入困境。这些命令对我来说是“命中注定”。

我已经添加了 Application.Wait (Now + TimeValue("0:00:05")) 在Loops之前，并且现在看来仍然有效。

是否有任何可靠的命令，无论互联网速度如何，都会真正暂停代码处理，直到网页完全加载为止？问题是我的代码吗？

Sub Test()
    Dim IE As Object
    Dim Element As String
    Dim i As Long

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

    'Navagate To Website
    IE.navigate "https://www.website.com/"
    Application.Wait (Now + TimeValue("0:00:02"))

    IE.document.getElementById("ElementName1").Focus

    'SignOn Website
    IE.document.getElementById("ElementName1").Value = "UserID"
    Application.Wait (Now + TimeValue("0:00:01"))

    IE.document.getElementById("ElementName2").Value = "Password"
    Application.Wait (Now + TimeValue("0:00:02"))

    IE.document.getElementById("ElementName2").Click

    'Wait for next page ***************************************
    Application.Wait (Now + TimeValue("0:00:05"))
    Do While IE.Busy: DoEvents: Loop
    '**********************************************************

    'Enter Patient Data On Website
    Dim pgTAGS As Object
    Dim pgTag As Object
    Set pgTAGS = IE.document.getElementsByTagName("input")
    For Each pgTag In pgTAGS ' Loop through every input tag
    If pgTag.className = "chosen-search-input default" And _
            pgTag.Value = "Enter at least 3 Characters" Then
            pgTag.Focus
            Application.Wait (Now + TimeValue("0:00:01"))
            SendKeys "{1}{2}{3}", True
            Application.Wait (Now + TimeValue("0:00:01"))
            SendKeys "{ENTER}", True
            SendKeys "{TAB}", True ' Seems to be required to exit dropdown list field
            Exit For
        End If
    Next pgTag

    'Member ID
    IE.document.getElementById("memberID").Value = "A99999999999"
    SendKeys "{TAB}", True

    'Date of Birth
    IE.document.getElementById("memberDOB").Value = "01/01/1977"
    SendKeys "{TAB}", True

    SendKeys "{TAB}", True

    'Date of Service: From
    IE.document.getElementById("memberFromDate").Value = "08/08/2008"
    SendKeys "{TAB}", True

    'Date of Service: To
    IE.document.getElementById("memberToDate").Value = "08/08/2008"
    SendKeys "{TAB}", True ' Seems to be required to highlight Search Claim button

    'BUTTON: Search Claims
    SendKeys "{ENTER}", True

    'Wait for next page ***************************************
    Application.Wait (Now + TimeValue("0:00:05"))
    Do While IE.Busy: DoEvents: Loop
    '**********************************************************

    'Sub Scrape Data From Website
    Dim t As Integer, r As Integer, c As Integer
    Dim elmCollection As Object
    IE.document.Focus

    Set elmCollection = IE.document.getElementsByTagName("table")

    For t = 0 To (elmCollection.Length - 1)
        For r = 0 To (elmCollection(t).Rows.Length - 1)
            For c = 0 To (elmCollection(t).Rows(r).Cells.Length - 1)
                ThisWorkbook.Worksheets(1).Cells(r + 1, c + 1) = _
                elmCollection(t).Rows(r).Cells(c).innerText
            Next c
        Next r
    Next t

    Set IE = Nothing
End Sub

等待网页完成加载

0 个答案: