VBA复制网站数据

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

我试图使用macroslogging器和网页查询，但它一直显示错误脚本和黄色箭头没有出现在我想复制的部分。

这是我试图复制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请求，但我假设你有麻烦，因为它不等待服务器的响应。

我倾向于这样做networking刮：

 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 

---

确保你有一个参考：

1. 微软互联网控制
2. Microsoft HTML对象库

---

由于类包含一个列表，所以返回文本全部在一个元素中。 所以结果如下所示：

---

这是将结果分成不同单元格的一种方法：

 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 

---

结果：

---

说明

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

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

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

现在我们只是遍历结果数组并显示每行文本。 Select Case只是帮助我们知道哪一列显示下一行文本的格式良好的显示。

Answer 2

我在这里尝试了这种方法，但它不适合我。 我在用户JerryD的Ozgrid上find了拉网页到工作表 ，我将其包括在内，供将来参考。

 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