Код VBA для копирования таблицы с веб-страницы в Excel

Question

Я изменил код, чтобы попытаться получить последовательность похожих таблиц. Однако эти таблицы, скопированные в соответствующие листы, абсолютно одинаковы, то есть таблица для первой переменной / листа была реплицирована на другие листы, созданные для разных переменных - таблицы должны быть разными на разных листах. Что не так с моим новым кодом? Ваш совет снова будет очень признателен!

Sub CopyWebTable()

    Dim IE As InternetExplorer, hTable As Object, clipboard As Object, t As Date
    Dim Var As String
    Const MAX_WAIT_SEC As Long = 5

    For i = 1 To 3
        Var = ThisWorkbook.Worksheets("Par").Range("B" & i + 2)

        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        Set IE = New InternetExplorer

        With IE
            .Visible = True
            .Navigate2 "https://eresearch.fidelity.com/eresearch/evaluate/fundamentals/earnings.jhtml?tab=details&symbols=" & Var

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

            t = Timer                            'timed loop for details table to be present
            Do
                On Error Resume Next
                Set hTable = IE.document.querySelector(".earningsHistoryTable-Cont table")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While hTable Is Nothing
            If Not hTable Is Nothing Then        'use clipboard to copy paste
                clipboard.SetText hTable.outerHTML
                clipboard.PutInClipboard
                ThisWorkbook.Worksheets(Var).Range("A1").PasteSpecial

            End If
        End With
    Next i

End Sub

Answer 1

Попробуйте следующую конструкцию, в которой мы перемещаем цикл по переменным внутри создания объекта IE и следим за тем, чтобы hTable всегда был равен нулю перед повторным циклом.

Option Explicit

Sub CopyWebTable()

    Dim IE As InternetExplorer, hTable As Object, clipboard As Object, t As Date
    Dim Var As String
    Const MAX_WAIT_SEC As Long = 5
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set IE = New InternetExplorer

    With IE
        .Visible = True

        For i = 1 To 3
            Var = ThisWorkbook.Worksheets("Par").Range("B" & i + 2)

            .Navigate2 "https://eresearch.fidelity.com/eresearch/evaluate/fundamentals/earnings.jhtml?tab=details&symbols=" & Var

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

            t = Timer                            'timed loop for details table to be present
            Do
                On Error Resume Next
                Set hTable = .document.querySelector(".earningsHistoryTable-Cont table")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While hTable Is Nothing
            If Not hTable Is Nothing Then        'use clipboard to copy paste
                clipboard.SetText hTable.outerHTML
                clipboard.PutInClipboard
                ThisWorkbook.Worksheets(Var).Range("A1").PasteSpecial
                Set hTable = Nothing
            End If
        Next i
    End With
End Sub