从多个url中刮取html表格

我正在尝试从一系列url中删除表格内容。 我一直在处理下面的代码，它执行以下步骤：

1. 在工作表“开始”（1，2，3等）中的范围A1：A3中添加基于值的新工作表。
2. 根据相同的值创buildurl（，2，3等）
3. 激活新的工作表
4. 打开url和刮表

发生以下情况：

1. 新的工作表被添加（1，2，3）
2. 工作表（“1”）包含表
3. 工作表（“2”）和下列内容保持空白

已添加url – http://cao.szw.nl/index.cfm?fuseaction=app.caoOverzicht&menu_item_id=16534&hoofdmenu_item_id=16507&rubriek_item=392846&rubriek_id=392840&strSorteerWijze=asc&strGesorteerdeKolom=cao_naam&pagenumber=1

注 – 该网站完全是荷兰语;）

错误在哪里？

Sub TableExample() Dim IE As Object, doc As Object Dim strURL As String Dim ws As Worksheet, wsActive As Worksheet Dim i As Long, tabno As Long, nextrow As Long Dim cell As Range Dim MyNames As Range, MyNewSheet As Range Dim tbl As Object, rw As Object, cl As Object Set ws = Sheets("Start") With ws Dim rng As Range Set rng = .Range("A1:A3") For Each cell In rng Sheets.Add.Name = cell.Value Set wsActive = ThisWorkbook.ActiveSheet strURL = "http://xxx&pagenumber=" & cell.Value Set IE = CreateObject("InternetExplorer.Application") With IE '.Visible = True .navigate strURL Do Until .readyState = 4: DoEvents: Loop Do While .Busy: DoEvents: Loop Set doc = IE.document With wsActive For Each tbl In doc.getElementsByTagName("TABLE") tabno = tabno + 1 nextrow = nextrow + 1 Set rng = wsActive.Range("B" & nextrow) rng.Offset(, -1) = "Table " & tabno For Each rw In tbl.Rows For Each cl In rw.Cells rng.Value = cl.outerText Set rng = rng.Offset(, 1) i = i + 1 Next cl nextrow = nextrow + 1 Set rng = rng.Offset(1, -i) i = 0 Next rw Next tbl End With End With Next End With IE.Quit End Sub 

Answer 1

检查你的代码，并简单化它，它适用于我。 顺便说一句。 for-each表格行，单元格都没有错，它们是有效的对象。

 Option Explicit Sub TableExample() Dim IE As Object, doc As Object Dim strURL As String Dim ws As Worksheet, wsActive As Worksheet Dim i As Long, tabno As Long, nextrow As Long Dim cell As Range Dim MyNames As Range, MyNewSheet As Range Dim tbl As Object, rw As Object, cl As Object Dim rng As Range Set IE = CreateObject("InternetExplorer.Application") IE.Visible = True Set ws = Sheets("Start") Set rng = ws.Range("A1:A3") For Each cell In rng Sheets.Add.Name = cell.Value Set wsActive = ThisWorkbook.ActiveSheet strURL = "http://xxx&pagenumber=" & cell.Value IE.navigate strURL Do Until IE.readyState = 4: DoEvents: Loop Set doc = IE.document For Each tbl In doc.getElementsByTagName("TABLE") tabno = tabno + 1 nextrow = nextrow + 1 Set rng = wsActive.Range("B" & nextrow) rng.Offset(, -1) = "Table " & tabno For Each rw In tbl.Rows For Each cl In rw.Cells rng.Value = cl.outerText Set rng = rng.Offset(, 1) i = i + 1 Next cl nextrow = nextrow + 1 Set rng = rng.Offset(1, -i) i = 0 Next rw Next tbl Next cell IE.Quit End Sub