Question

我有一个用VBA编写的程序，它擦除了我正在使用的网站的第一个表。我添加了一个组件，通过单击下一个按钮查看下一个50个结果来遍历该页面上的所有项目。

我遇到的问题是编码我引用的表格。我的代码只占用网页上的第一个表，我需要所有表格，但我还需要程序点击所有结果。

这是我的代码：

Sub ETFDat()

 Dim ie As Object, i As Long, strText As String
 Dim jj As Long
 Dim hBody As Object, hTR As Object, hTD As Object
 Dim tb As Object, bb As Object, Tr As Object, Td As Object, ii As Long
 Dim doc As Object, hTable As Object
 Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

 Set wb = Excel.ActiveWorkbook
 Set ws = wb.ActiveSheet

 Set ie = CreateObject("InternetExplorer.Application")
 ie.Visible = True

  y = 1   'Column A in Excel
  z = 1   'Row 1 in Excel
 Sheets("Fund Basics").Activate
 Cells.Select
 Selection.Clear

 ie.navigate "http://www.etf.com/channels/smart-beta-etfs/channels/smart-   beta-etfs?qt-tabs=0#qt-tabs" ', , , , "Content-Type: application/x-www-form-urlencoded" & vbCrLf

 Do While ie.busy: DoEvents: Loop
 Do While ie.ReadyState <> 4: DoEvents: Loop

 Set doc = ie.document
 Set hTable = doc.getElementsByTagName("table") '.GetElementByID("tablePerformance")

 ii = 1
 Do While ii <= 17

 For Each tb In hTable

    Set hBody = tb.getElementsByTagName("tbody")
    For Each bb In hBody

        Set hTR = bb.getElementsByTagName("tr")
        For Each Tr In hTR


            Set hTD = Tr.getElementsByTagName("td")
            y = 1 ' Resets back to column A
            For Each Td In hTD
               ws.Cells(z, y).Value = Td.innerText
               y = y + 1
             Next Td
             DoEvents
             z = z + 1
        Next Tr
        Exit For
    Next bb
Exit For
 Next tb

 With doc


Set elems = .getElementsByTagName("a")
For Each e In elems

    If (e.getAttribute("id") = "nextPage") Then
        e.Click
        Exit For
    End If

Next e

End With

ii = ii + 1
Application.Wait (Now + TimeValue("00:00:05"))
Loop

MsgBox "Done"

End Sub

Answer 1

我认为如果你调用他们的json文件然后在你的VBS代码中解析它，你会有更轻松的时间。

http://www.etf.com/etf-finder-channel-tag/Smart-Beta%20ETFs/-aum/50/50/1
http://www.etf.com/etf-finder-channel-tag/Smart-Beta%20ETFs/-aum/50/50/2
http://www.etf.com/etf-finder-channel-tag/Smart-Beta%20ETFs/-aum/50/50/3

...

VBA webscraping跨Javascript网站的多个表和页面

1 个答案: