代码运行时无法使用 Excel

Question

我正在尝试使用此代码从 Web 收集/抓取数据：

Sub GetSP()
Dim appIE As Object

Set appIE = CreateObject("internetexplorer.application")

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

Do While appIE.Busy
    DoEvents
Loop

RunCodeEveryX:

Set allRowOfData = appIE.document.getElementById("pair_1")
Dim myValue As String: myValue = allRowOfData.Cells(2).innerHTML
Range("A1").Value = myValue

Application.Wait Now + TimeValue("00:00:01")
GoTo RunCodeEveryX

appIE.Quit
Set appIE = Nothing

End Sub

但是，当代码运行时，我什至无法编辑 Excel，因为 Excel 似乎正忙于获取数据。我希望代码正在运行，我可以在同一张纸上做一些事情，同时继续进行网络抓取。

现在有其他选择吗？ （我认为这让 Excel 很忙）

谢谢！

@jeeped - 我能够使用您的首选模式收集适当的数据并成功提取数据。我想知道是否有一种好方法可以无限重复此步骤（由于网页上的数据正在刷新，我希望像我的初始代码一样重复此步骤）直到我停止它同时能够编辑工作表的其余部分.

谢谢！希望你不介意我专门向你提问，尽管这个问题对每个人都是开放的。

Sub GetSP()

Dim HTMLDoc As New HTMLDocument
Dim oHttp As MSXML2.xmlHTTP


On Error Resume Next
Set oHttp = New MSXML2.xmlHTTP
If Err.Number <> 0 Then
    Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
    MsgBox "Error 0 has occured"
End If
On Error GoTo 0
If oHttp Is Nothing Then
    MsgBox "Just cannot make"
    Exit Sub
End If

oHttp.Open "GET", "http://uk.investing.com/currencies/streaming-forex-rates-majors", False
oHttp.send
HTMLDoc.body.innerHTML = oHttp.responseText

With HTMLDoc
    PriceGetter = .getElementById("pair_1").innerText
    PriceGetter2 = .getElementsByClassName("pid-1-bid")(0).innerText
    Range("A1").Value = PriceGetter
    Range("A2").Value = PriceGetter2
End With

End Sub

Answer 1

您可以使用循环代替Application.Wait。当您在其中使用DoEvents 时，该应用程序仍然响应。

如果你在 Windows 上，这里有一个会休眠一段时间的函数：

Declare Function GetTickCount Lib "kernel32.dll" () As Long

Function Sleep(milliseconds As Long)


Dim NowTick As Long
Dim EndTick As Long

EndTick = GetTickCount + (milliseconds)

Do
    NowTick = GetTickCount
    DoEvents
Loop Until NowTick >= EndTick
End Function

这样称呼它：

Sleep 1000 'Sleeps for 1 Second