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

代码运行时无法使用Excel

1 个答案: