Как оптимизировать Excel VBA для клика по URL - PullRequest
0 голосов
/ 18 октября 2019

Ошибка времени выполнения "70" во время работы VBA.

Иногда код работает нормально, а иногда нет. Хотите знать, если есть более надежный код для продолжения. Он всегда останавливается в If link.innerHTML = "Balance Sheet" Then end if

Public Sub Get()

Dim ie As Object
Dim URL As String, link As Object, alllinks As Object
Dim eRowa As Long, eRowb As Long, eRowc As Long
Dim var As Object

Set var = ThisWorkbook.Worksheets("Sheet2").Cells(1, 1)
URL = "https://www.marketwatch.com/investing/stock/" & var & "/financials"

Set ie = CreateObject("internetexplorer.application")

With ie

    .Visible = True
    .navigate URL

    While .Busy Or .readyState < 4: DoEvents: Wend

    Set alllinks = ie.document.getElementsByTagName("a")

    For Each link In alllinks

         If link.innerHTML = "Balance Sheet" Then

             link.Click

         End If

    Next link

    While .Busy Or .readyState < 4: DoEvents: Wend

End With

Set ie = Nothing


End Sub

Ожидается плавный ход без ошибок 70

1 Ответ

0 голосов
/ 18 октября 2019

Используйте синхронизированный цикл для ожидания наличия тега a. Используйте attribute = value css селектор с $ заканчивается оператором для более быстрого нацеливания соответствующего элемента

Option Explicit

Public Sub GetInfo()
    Dim ie As Object, url As String, link As Object
    Dim var As Range, t As Date
    Const MAX_WAIT_SEC As Long = 10

    Set var = ThisWorkbook.Worksheets("Sheet2").Cells(1, 1)

    url = "https://www.marketwatch.com/investing/stock/" & var.value & "/financials"

    Set ie = CreateObject("InternetExplorer.Application")

    With ie
        .Visible = True
        .navigate2 url

        While .Busy Or .readyState < 4: DoEvents: Wend

        t = Timer
        Do
            On Error Resume Next
            Set link = .document.querySelector("[href$='/balance-sheet']")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While link Is Nothing

        If link Is Nothing Then Exit Sub

        link.Click

        While .Busy Or .readyState < 4: DoEvents: Wend

        Stop '<== Delete me later
        .Quit
    End With
End Sub
...