我正在研究VBA脚本,并且我被困在应该如此容易的事情上。无论如何,VBA代码从sheet1中获取成员编号,打开经过验证的IE窗口,在成员编号中弹出,从HTML页面中删除某些表并将它们插入Sheet 2中。然后,它将转到Sheet 1中的下一个成员编号。不过,我正在努力将刮取的数据转化为sheet2。当我运行代码时,一切都按照计划进行,除了每次都将所有内容插入到工作表2中的相同位置。所以当代码完成时,我所拥有的是来自sheet1上最后一个成员的数据。使用VBA将抓取的HTML数据格式化为excel - 将无法正确显示
Option Explicit
Sub TableExample()
Dim IE As Object
Dim doc As Object
Dim strURL As String
Dim hicN As String
strURL = "exampleURL.com"
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
Do Until IsEmpty(ActiveCell)
memNum = ActiveCell
doc.getelementbyid("claimNumber").Value = memNum
doc.all("submitBtn").Click
Do While .Busy: DoEvents: Loop
GetAllTables doc, memNum
ActiveCell.Offset(1, 0).Select
Loop
'.Quit
End With
End Sub
的GetAllTables方法 -
Sub GetAllTables(doc As Object, memNum As String)
' get all the tables from a webpage document, doc, and put them in a new worksheet
Dim ws As Worksheet
Dim rng As Range
Dim tbl As Object
Dim rw As Object
Dim cl As Object
Dim tabno As Long
Dim nextrow As Long
Dim I As Long
Set ws = Sheet2
For Each tbl In doc.getElementsByTagName("TABLE")
tabno = tabno + 1
If tabno = 11 Or tabno = 13 Or tabno = 16 Then
nextrow = nextrow + 1
Set rng = ws.Range("B" & nextrow)
'Debug.Print nextrow
rng.Offset(, -1) = memNum
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
End If
Next tbl
End Sub
+0
这将有助于如果你能给出确切的网址 –