Цикл следующего документа веб-браузера завершен

Question

Excel VBA, как дождаться полной загрузки Webbrowser, прежде чем перейти к следующей строке и выполнить вызов, см. Код ниже, любые предложения приветствуются.

Попытка использовать Worksheet_SelectionChange безуспешно, так как скрипт выполняет выбор ActiveCell.Row без остановки.

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Sheet1.Cells.Interior.ColorIndex = xlColorIndexNone
    Sheet1.Cells.Borders.ColorIndex = xlColorIndexNone
    Sheet1.Cells(ActiveCell.Row, 3).Interior.ColorIndex = 19
    Sheet1.Cells(ActiveCell.Row, 3).Borders.Color = vbRed
    Sheet1.Cells(1, 3).Interior.ColorIndex = 19
    Sheet1.Cells(1, 3).Borders.Color = vbRed
    Application.ScreenUpdating = True
    Cells(ActiveCell.Row, 1).Select
'HOW TO LOOP Call AutoDomain with using Selection.Offset(1, 0).Select?
'while waiting for webbrowser to completely load before moving to next row and executing Call AutoDomain
'Selection.Offset(1, 0).Select
'AutoDomain
    End
End Sub
Sub AutoDomain()
    Dim xURL As String
    Application.Speech.Speak "Starting Look Up", Speakasync:=True, Purge:=True
    xURL = Cells(ActiveCell.Row, 1)
    Cells(1, 3).Value = ""
    Cells(1, 3).Interior.ColorIndex = xlNone
    Cells(1, 3).Borders.Color = xlNone
    Cells(ActiveCell.Row, 3).Value = ""
    WebBrowser1.Silent = True
    WebBrowser1.Navigate (xURL)
    Sheets(1).Calculate
    End
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    WebBrowser1.Stop
    URL = Cells(ActiveCell.Row, 1)
    Cells(1, 3).Value = WebBrowser1.LocationURL
    Cells(1, 3).Interior.ColorIndex = 19
    Cells(1, 3).Borders.Color = vbRed
    Cells(ActiveCell.Row, 3).Value = "DOMAIN : " & WebBrowser1.LocationURL & vbCrLf & "TITLE  : " & WebBrowser1.LocationName
    Do Until Cells(ActiveCell.Row, 3).Value <> ""
        DoEvents
    Loop
    Application.Speech.Speak " Look Up Completed ", Speakasync:=True, Purge:=True
    'SPEECH IS CONTINUING EXTRA TIMES WITHOUT STOPPING SOMETIME, used END to attempt to force speech to stop
    End
End Sub

Answer 1

Я использую этот пользовательский саб, который работает примерно в 90% моих случаев, когда мне нужно ждать загрузки страницы:

Sub Wait()

While (IE.Busy Or IE.READYSTATE <> 4): DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))

End Sub

Вам необходимо заменить IE на WebBrowser1.

Таким образом, вы можете поместить это в нижней части вашего модуля, а затем изменить строку на:

WebBrowser1.Navigate (xURL): Wait