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对象内部的var上，并确保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

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

1 个答案: