将表格从网页复制到 Excel 的 VBA 代码

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 对象的创建中将循环移到 vars 上，并确保在再次循环之前始终将 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