Question

有人可以帮我指出如何通过VBA将特定数据从网站复制到Excel表格的正确方向吗？

我尝试使用宏录制器和网页查询，但它一直显示错误脚本，黄色箭头没有显示在我要复制的部分。

这是我试图复制的网站http://etfdb.com/etf/EEM/#holdings

我只想复制十大控股部分。

非常感谢任何帮助。提前谢谢。

编辑：这是我现在的代码，但没有出现，有人能告诉我什么错了吗？

Sub Get123()

Dim oHtml       As HTMLDocument
Dim oElement    As Object

Set oHtml = New HTMLDocument

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", "http://etfdb.com/etf/EEM/#holdings", False
    .send
    oHtml.body.innerHTML = .responseText
End With

For Each oElement In oHtml.getElementsByClassName("holdings-left-content")
    ActiveSheet.Range("A1").Value = oElement.Value
Next oElement

End Sub

Answer 1

我对WINHTTP请求不太熟悉，但我假设你遇到了麻烦，因为它不等待来自服务器的响应。

我倾向于以这种方式进行网络抓取：

Sub extract()
    Dim IE As InternetExplorer
    Dim html As HTMLDocument

    Set IE = New InternetExplorerMedium
    IE.Visible = False
    IE.Navigate2 "http://etfdb.com/etf/EEM/#holdings"

    ' Wait while IE loading
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set html = IE.document
    Set holdingsClass = html.getElementsByClassName("holdings-left-content")

    Range("A1").Value = holdingsClass(0).textContent

    'Cleanup
    IE.Quit
    Set IE = Nothing
End Sub

确保您参考：

Microsoft Internet Controls
Microsoft HTML对象库

由于该类包含一个列表，因此返回文本都在一个元素中。所以结果看起来像这样：

enter image description here

以下是将结果拆分为不同单元格的一种方法：

Dim results As Variant
results = Split(holdingsClass(0).textContent, vbLf)

cntr = 1
For i = LBound(results) To UBound(results)
    If Trim(results(i)) <> "" Then
        Select Case Right(Trim(results(i)), 1)
            Case ":"
                Range("B" & cntr) = CStr(Trim(results(i)))
            Case "%"
                Range("C" & cntr).Value = Trim(results(i))
                cntr = cntr + 1
            Case 0
                Range("C" & cntr).Value = Trim(results(i))
            Case Else
                Range("A" & cntr).Value = Trim(results(i))
        End Select
    End If
Next i

结果：

enter image description here

<强>解释

getElements...返回符合给定条件的所有html元素的数组。在这种情况下，它返回类名为“holdings-left-content”的所有元素。

由于只有一个具有此类名的元素，我们使用(0)访问第一个元素，因为它是一个基于零的数组（0,1,2表示3个元素而不是1,2,3）。

Split方法获取第一个数组元素中的所有文本，并使用回车符vbLf作为分隔符将每一行分隔为另一个数组（结果）。

现在我们只循环遍历结果数组并显示每行文本。 Select Case只是帮助我们知道哪一列显示下一行文本，以便格式化。

Answer 2

我在这里试过这种方法，但它并不适合我。我在用户 JerryD 的 Ozgrid 上找到Pull Web Page Into Worksheet，我将其包含在此处，以供将来参考。

Sub Test() 

    Dim IE As Object 

    Sheets("Sheet3").Select 
    Range("A1:A1000") = "" ' erase previous data
    Range("A1").Select 

    Set IE = CreateObject("InternetExplorer.Application") 
        With IE 
            .Visible = True 
            .Navigate "http://www.aarp.org/" ' should work for any URL
            Do Until .ReadyState = 4: DoEvents: Loop 
        End With 

        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False 
        Range("A1").Select 
        IE.Quit 

End Sub

VBA复制网站数据

2 个答案: