Question

为了修复the following code，我尝试将其拆分为较小的部分。所以，我有以下代码让我在Sheet1中疯了几个小时：

    Sub Scrapping_Data()
    Dim IE As Object, EURUSD1 As String, EURUSD2 As String
    Application.ScreenUpdating = False
    Range("A:B").Clear

    Set IE = CreateObject("internetexplorer.application")

    With IE
       .Navigate "http://uk.investing.com/currencies/streaming-forex-rates-majors"
       .Visible = False
    End With    

    Do
        DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE

    Set FOREX = IE.document.getElementById("pair_1")
    EURUSD1 = FOREX.Cells(1).innerHTML
    EURUSD2 = FOREX.Cells(2).innerHTML
    IE.Quit
    Set IE = Nothing

    Range("A1").Value = EURUSD1
    Range("B1").Value = EURUSD2
    End Sub

我是第一次运行它并且运行正常。但是当我第二次运行它时，错误发生了运行时错误“91”。所以我点击 F8 ，但没有任何事情发生，代码工作正常，我检查了Sheet1，Cells(1,1)和Cells(1,2)中有值。然后我再次运行它，错误，这次发生了运行时错误“13”。我再次单击 F8 ，但没有任何反应，代码工作正常。当我继续运行代码时，错误仍然发生，单击 F8 无助于找到问题。我的代码出了什么问题？如何解决？

我在这里得不到的是我的笔记本电脑每次运行代码都变慢，我必须多次手动重启。

Answer 1

^{以下要求您进入VBE的工具►参考，并在 Microsoft HTML对象库和 Microsoft XML v6.0 旁边放置复选标记}

这是一个xmlhttprewuest等效的Internet Explorer对象Web抓取到同一个URL。

Option Explicit

Sub tournamentFixtures()
    'declare the objects with early binding
    Dim htmlBDY As New HTMLDocument, xmlHTTP As New MSXML2.XMLHTTP60
    'declare the regular variables
    Dim sURL As String, ws As Worksheet

    'set a var object to the destination worksheet
    Set ws = Worksheets("Sheet1")

    'assign the URL to a string var
    sURL = "http://uk.investing.com/currencies/streaming-forex-rates-majors"

    'isolate all commands to the MSXML2.XMLHTTP60 object
    With xmlHTTP
        'initiate the URL
        .Open "GET", sURL, False
        'set hidden header information
        .setRequestHeader "User-Agent", "XMLHTTP/1.0"
        'get the page data
        .send

        'safety check to make sure we got the web page's data
        If .Status <> 200 Then GoTo bm_safe_Exit

        'if here you got the page data - copy it to the local var
        htmlBDY.body.innerHTML = .responseText
    End With

    'localize all commands to the page data
    With htmlBDY
        'check if the element ID exists
        If Not .getElementById("pair_1") Is Nothing Then
            'it exists - get the data directly to the worksheet
            With .getElementById("pair_1")
                ws.Range("A1") = .Cells(1).innerText
                ws.Range("B1") = .Cells(2).innerText
            End With
        Else
            'it doesn't exist - bad page data
            MsgBox "there is no 'pair_1' on this page"
        End If

    End With

bm_safe_Exit:
    'clean up all of the objects that were instantiated
    Set htmlBDY = Nothing: Set xmlHTTP = Nothing: Set ws = Nothing
End Sub

我几乎对每一行都进行了评论，因此您可以关注正在发生的事情。这可能需要一些调整。我跑了大约40次，它失败了一次，但那可能是我自己的互联网连接。考虑这是一个起点，您可以自己进行研究以实现目标。如果您仍然遇到此新代码的问题，请不要将其粘贴到另一个问题中，并询问为什么在没有进行某些研究和自己尝试解决方案的情况下它无法正常工作。 StackOverflow是专业和发烧友程序员的网站。

_{我放弃了尝试提供网络抓取问题的解决方案，因为页面技术变化太快，无法跟上外设。您必须参与即时更改才能快速响应它们，并且我自己的兴趣在于其他地方。我回复了这个请求，因为你实际提供了测试的URL（很少有人提出问题，实际上认为这很重要 - 去图）我觉得var的静态调暗会有所帮助。}

Answer 2

InternetExplorer object的构建和破坏需要时间;甚至在最快的系统上也可以持续几秒钟。您可以等待适当的时间让它放弃已加载的所有.DLL等，或者您可以将IE声明为静态对象，该子对象将在子过程的后续重新运行时重用。

Option Explicit

Sub Scrapping_Data()
    Static IE As Object
    Dim EURUSD1 As String, EURUSD2 As String

    Application.ScreenUpdating = False
    With Worksheets("Sheet1")   'KNOW what worksheet you are on!!!!!
        .Range("A:B").Clear
    End With

    If IE Is Nothing Then
        Set IE = CreateObject("internetexplorer.application")
        With IE
            .Visible = True
            '.Visible = False
            .Silent = True
        End With
    End If

    With IE
       .Navigate "http://uk.investing.com/currencies/streaming-forex-rates-majors"
       Do While .ReadyState <> 4: DoEvents: Loop
       With .document.getElementById("pair_1")
            EURUSD1 = .Cells(1).innerHTML
            EURUSD2 = .Cells(2).innerHTML
       End With
    End With

    With Worksheets("Sheet1")   'KNOW what worksheet you are on!!!!!
        .Range("A1") = EURUSD1
        .Range("B1") = EURUSD2
    End With

    IE.Navigate "about:blank"

End Sub

这里需要注意的是，您必须在将来的某个时刻自行销毁InternetExplorer对象。关闭工作簿将关闭VBA项目，但保留IE对象“孤立”。

鉴于该网页附带的所有HTML5碎片，您是否考虑过转移到xmlhttprequest？如果你想知道是的话，那将是一个不同的[标签]集合下的新问题。

代码通过F5或F8运行一次/两次，但随后会出现多个错误

2 个答案: