下面的代码有一个我无法修复的错误。
代码设法成功复制前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