关于网页中分页表格批量导出问题——已解决

连珠白

求助各位老师
现有网页：http://210.75.206.60/tjsqba/applyInfo.do?method=getallApplyList
共有1372页，如何用VBA，将所有页的数据导出到excel中？
求指点，谢谢。

jokklx

录制了个宏，发现提交数据真是地址为
URL;http://210.75.206.60/tjsqba/appl ... 3715&to_page=12
上面goto_page=12，to_page=12均为显示第12页的内容
所以录制的宏可以修改为

1. Sub aa(i As Integer, a As Range)
   
2. Dim t As String
   
3. t = "URL;http://210.75.206.60/tjsqba/applyInfo.do?method=getallApplyList&serialNumber=&name=&pdeptid=&updeptid=&page_flag=true&pagesize_key=default&page_order=&goto_page=12&current_page=3&total_count=13715&to_page=12"
   
4.     With ActiveSheet.QueryTables.Add(Connection:=t, Destination:=a)
   
5.         .Name = "applyInfo.do?method=getallApplyList"
   
6.         .FieldNames = True
   
7.         .RowNumbers = False
   
8.         .FillAdjacentFormulas = False
   
9.         .PreserveFormatting = True
   
10.         .RefreshOnFileOpen = False
    
11.         .BackgroundQuery = True
    
12.         .RefreshStyle = xlInsertDeleteCells
    
13.         .SavePassword = False
    
14.         .SaveData = True
    
15.         .AdjustColumnWidth = True
    
16.         .RefreshPeriod = 0
    
17.         .WebSelectionType = xlSpecifiedTables
    
18.         .WebFormatting = xlWebFormattingNone
    
19.         .WebTables = "4"
    
20.         .WebPreFormattedTextToColumns = True
    
21.         .WebConsecutiveDelimitersAsOne = True
    
22.         .WebSingleBlockTextImport = False
    
23.         .WebDisableDateRecognition = False
    
24.         .WebDisableRedirections = False
    
25.         .Refresh BackgroundQuery:=False
    
26.     End With
    
27. End Sub

复制代码

然后再用另外一个模块循环调用1372页，
例如
Sub bb()
Dim i As Integer
For i = 1 To 1372
Call aa(i, Range("a" & (i - 1) * 11 + 1))
Next
End Sub
等待全部搞定，再处理一下标题即可

连珠白

jokklx 发表于 2015-1-11 18:24
录制了个宏，发现提交数据真是地址为
URL;http://210.75.206.60/tjsqba/applyInfo.do?method=getallApplyL ...

非常感谢您的帮助
但是代码点击运行，并没有运行，显示出一个对话框

C:\Users\xiangfeng\Desktop\捕获.JPG

liangdonghao222

连珠白 发表于 2015-1-11 18:59
非常感谢您的帮助
但是代码点击运行，并没有运行，显示出一个对话框

这是什么提示

连珠白

liangdonghao222 发表于 2015-1-11 19:04
这是什么提示

我也不知道，貌似excel没有运行代码。
我的步骤是：
1.录制宏
2.停止录制
3.宏-选择刚才产生的“宏1”-编辑，然后粘贴代码
4.点击绿三角运行，现在就出一个“宏”的对话框。。。。。

liangdonghao222

连珠白 发表于 2015-1-11 19:07
我也不知道，貌似excel没有运行代码。
我的步骤是：
1.录制宏

用xmlhttp方法可能好点吧。不用后续处理标题

bluexuemei

1. Sub getwebdata()
   
2.     Dim url$, html As Object, xmlhttp As Object, p&, n&, i%, j%
   
3.     Set html = CreateObject("htmlfile")
   
4.     Set xmlhttp = CreateObject("msxml2.xmlhttp")
   
5.     For p = 0 To 1371
   
6.         url = "http://210.75.206.60/tjsqba/applyInfo.do?method=getallApplyList&serialNumber=&name=&pdeptid=&updeptid=&page_flag=true&pagesize_key=default&page_order=&goto_page=next&current_page=" & p & "&total_count=13715&to_page="
   
7.         With xmlhttp
   
8.             .Open "get", url, False
   
9.             .send
   
10.             html.body.innerhtml = .responseText
    
11.         End With
    
12.         Set tb = html.body.getelementsbytagname("tr")
    
13.         For i = IIf(p > 0, 8, 7) To tb.Length - 5
    
14.           n = n + 1
    
15.           For j = 0 To tb(i).childnodes.Length - 1
    
16.            Sheet1.Cells(n, j + 1) = tb(i).childnodes(j).innertext
    
17.           Next
    
18.         Next
    
19.     Next
    
20.     Set html = Nothing
    
21.     Set xmlhttp = Nothing
    
22. End Sub

复制代码

浮华、缠绕指尖

see if help you 数据下载.rar (410.81 KB, 下载次数: 394)

2015-1-11 19:20 上传

点击文件名下载附件

连珠白

问题已经解决，非常感谢jokklx 、bluexuemei 、浮华、缠绕指尖 和liangdonghao222 的指点，和各位网友的关注！！！

jingli_17

求教如何看网页的真实网址，如下：http://www.zfcg.sh.gov.cn/bulletininfo.do?method=electResultBulletin，求大神帮忙看一下如何导出这个网页的数据，跪谢！