VBA如何批量抓取数据

VBA如何批量抓取数据

sub extractdata()
dim c3value,g3value,c4value,e4value,c5value
excelfilename = Dir("E:\3月\" & "*.xls")
Do While excelfilename <> ""
s = "E:\3月\" & excelfilename
Workbooks.Open Filename:=s
Workbooks(excelfilename).Activate
activeworkbook.sheets("进料检验报表").activate
c3value=activesheet(3,"C")
g3value=activesheet(3,"G")
c4value=activesheet(4,"C")
e4value=activesheet(4,"E")
c5value=activesheet(5,"C")
workbooks(合并到的excel).activate
activesheet.cells(1,1)="这是表头"
activesheet.cells(activesheet.usedrange.rows.count+1,1)=c3value
activesheet.cells(activesheet.usedrange.rows.count+1,2)=g3value
activesheet.cells(activesheet.usedrange.rows.count+1,3)=c4value
activesheet.cells(activesheet.usedrange.rows.count+1,4)=e4value
activesheet.cells(activesheet.usedrange.rows.count+1,5)=c5value
(excelfilename).Close savechanges:=false
excelfilename = Dir '第二次读入的时候不用写参数
Loop
end sub追问说语法错误，什么情况啊。

Sub 按钮1_Click()
Dim url, html
n = 1
url = "http://www.zjcredit.gov.cn:8000/ListQuery.aspx"
For j = 1 To 5 '这里控制查询的页数
pd = "sectionID=02" _
& "&sortField=CreditID" _
& "&sortDirection=1" _
& "&recordTotal=3151" _
& "&pageNo=" & j _
& "&pageLength=20" _
& "&isOpen=False&isIntermediary=False" _
& "&query_AreaCode=" _
& "&query_OrganizationCode=" _
& "&query_BusinessLicense=" _
& "&query_CorporationName=" _
& "&query_LegalRepresentative=" _
& "&query_BusinessScope=" _
& "&query_PromptSymbol=D"
pd1 = "query_AreaCode=&query_OrganizationCode=&query_BusinessLicense=&query_CorporationName=&query_LegalRepresentative=&query_BusinessScope=&query_PromptSymbol=d&queryTitle=&businessLicense=&actionType=&searchType=§ionID=02&hot=&returnFunction=parent.reset_queryTitles&query2_AreaCode=0&query2_BusinessLicense=&query2_CorporationName=&query2_OrganizationCode=&query2_LegalRepresentative=&validateTextbox="
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp.6.0")
.Open "post", url, False
.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
.send (pd)
html.body.innerhtml = .responsetext
Set tr = html.all.tags("tr")
For i = 0 To tr.Length - 1
If tr(i).bgcolor = "#ffffff" Or tr(i).bgcolor = "#f3f3f3" Then
n = n + 1
Cells(n, 1) = tr(i).ChildNodes(0).innertext
Cells(n, 2) = tr(i).ChildNodes(1).innertext
End If
Next
End With
Next
End Sub
Sub 按钮2_Click()
Range("a2:b65536").ClearContents
End Sub