VBA复制网站数据 [英] VBA to copy website data

问题描述

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

我尝试使用宏记录器网络查询，但它不断显示错误脚本，黄色箭头没有显示在我想要复制的部分。

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

我只想复制十大控股零件。

任何帮助将不胜感激。谢谢你提前。

编辑：这是我目前的代码，但没有出现，有人可以告诉我什么问题？

  Sub Get123（）
 
 Dim oHtml As HTMLDocument 
 Dim oElement As Object 
 
 Set oHtml = New HTMLDocument 
 
使用CreateObject（WINHTTP.WinHTTPRequest.5.1）
。打开GET，http://etfdb.com/etf/EEM/#holdings，False 
 .send 
 oHtml.body.innerHTML = .responseText 
结束
 
对于每个oElement在oHtml.getElementsByClassName（holdings-left-content）
 ActiveSheet .Range（A1）。Value = oElement.Value 
下一个oElement 
 
 End Sub 
  

解决方案

我不太熟悉WINHTTP请求，但我假设你有麻烦，因为它不等待服务器的响应。

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

  Sub extract（）
 Dim IE As InternetExplore r 
 Dim html作为HTMLDocument 
 
设置IE =新的InternetExplorerMedium 
 IE.Visible = False 
 IE.Navigate2http://etfdb.com/etf/EEM /＃持有
 
'等待IE加载
尽管IE.Busy 
 Application.Wait DateAdd（s，1，Now）
循环
 
设置html = IE.document 
设置holdingsClass = html.getElementsByClassName（holdings-left-content）
 
范围（A1）。Value = holdingsClass 0）.textContent 
 
'清理
 IE.Quit 
设置IE =没有
结束Sub 
  

---

确保您参考：

1. Microsoft Internet Controls


2. Microsoft HTML对象库

---

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

---

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

  Dim results As Variant 
 results = Split（holdingsClass（0）.textContent，vbLf）
 
 cntr = 1 
对于i = LBound（结果）到UBound（结果）
如果Trim（results（i））<> 然后
选择案例权限（Trim（results（i）），1）
案例：
范围（B& cntr）= CStr（Trim ））
案例％
范围（C& cntr）.Value = Trim（results（i））
 cntr = cntr + 1 
案例0 
 Range（C& cntr）.Value = Trim（results（i））
 Case Else 
 Range（A& cntr）.Value = Trim（results（i） ）
结束选择
结束如果
下一个我
  

---

结果：

---

说明

getElements ... 返回满足给定条件的所有html元素的数组。在这种情况下，它返回具有类名称holdings-left-content的所有元素。

由于这个类名只有一个元素，所以使用（0）访问第一个元素，因为它是一个零基数组（对于3个元素而不是1,2,3）0,1,2。

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

现在我们只循环结果数组并显示每一行文本。 选择案例只是帮助我们知道哪一列可以显示格式正常的显示的下一行文本。

Can someone help to point me in a right direction on how to copy a particular data from a website to excel sheet via VBA?

I tried using macro recorder and web query but it keeps showing error script and the yellow arrow didn't show up at the part that i want to copy.

This is the website that i'm trying to copy http://etfdb.com/etf/EEM/#holdings

I only want to copy the Top Ten Holdings part.

Any help would be greatly appreciated. Thank you in advance.

Edit : This is my current code but nothing showed up, can someone tell me whats wrong?

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

解决方案

I'm not too familiar with WINHTTP request but I'm assuming your having trouble because it's not waiting for a response from the server.

I tend to do web scraping this way:

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

---

Make sure you have a reference to:

1. Microsoft Internet Controls
2. Microsoft HTML Object Library

---

Since the class contains a list the return text is all in one element. So the results look like this:

---

Here is one way to split the results up into different cells :

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

---

Results:

---

Explanation

getElements... returns an array of all html elements that meet the given criteria. In this case it returns all elements with the class name "holdings-left-content".

Since there is only one element with this class name we access the first element using (0) because it's a zero based array (0,1,2 for 3 elements instead of 1,2,3).

The Split method takes all text in first array element and separates each line into another array (results) using the carriage return vbLf as a delimiter.

Now we just loop through the results array and display each line of text. The Select Case just helps us know which column to display the next line of text for a nicely formatted display.

这篇关于VBA复制网站数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！