VBA代码可将表格从网页复制到Excel [英] VBA code to copy table from webpage into Excel

问题描述

我修改了代码以尝试获取一系列相似的表。但是，复制到各个工作表中的这些表是完全相同的，也就是说，第一个变量/工作表的表已复制到为不同变量创建的其他工作表中-在不同工作表上，表应该是不同的。我的新代码有什么问题？您的建议再次将不胜感激！

I have modified the code to try to get a sequence of similar tables. However, these tables copied into respective sheets are exactly the same, that is, the table for the first variable/sheet has been replicated to the other sheets which are created for different variables - the tables should be different on different sheets. What's wrong with my new code? Your advice again would be very appreciated!

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

推荐答案

尝试以下构造，将循环移至创建内容中的var上IE对象，并确保在再次循环之前将hTable始终设置为空。

Try the following construct where we move the loop over vars inside the creation of the IE object and ensure hTable is always set to nothing before looping round again.

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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！