使用VBA宏进行刮擦和循环

时间:2018-03-30 00:28:16

标签: excel vba excel-vba web-scraping

下面的代码有一个我无法修复的错误。

代码设法成功复制前50个记录并将其粘贴到表格中的Excel工作表中,但代码不会从第1页开始向所有其他页面前进并重复所有其他页面其他记录。

我希望代码能够将所有 111,582条记录复制并粘贴到我的Excel 表中,而不是连续执行前50条记录。

这是我到目前为止的代码,它可以在第一页复制数据表:

Sub LoopTest() 
    Dim ie As Object
    Dim i As Long
    Dim strText As String
    Dim doc As Object
    Dim hTable As Object
    Dim hBody As Object
    Dim hTR As Object
    Dim hTD As Object
    Dim tb As Object
    Dim bb As Object
    Dim tr As Object
    Dim td 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
    variable = 0

Here:
    ie.Navigate "website" & variable

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

    Set doc = ie.Document
    Set hTable = doc.getElementsByClassName("conBody conList")

    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

    variable = variable + 1
    GoTo Here:
End Sub

0 个答案:

没有答案