如何获取网页中特定表单中信息？

ccc919

网站如下所示
bzflh.szjs.gov.cn/TylhW/lhmcAction.do?method=queryYgbLhmcInfo&waittype=2#


如何读取每一行信息且读取备案回执单号中，户籍所在区到，execl中。。。。求助
显示结果为这样

看见星光

1. Sub DoHttp()
   
2.     Dim Dom As Object, Http As Object, objWindow As Object
   
3.     Dim strURL As String, strText As String
   
4.     Set Http = CreateObject("MSXML2.XMLHTTP")
   
5.     Set Dom = CreateObject("htmlfile")
   
6.     strURL = "http://bzflh.szjs.gov.cn/TylhW/lhmcAction.do?method=queryYgbLhmcList"
   
7.     ReDim arr(1 To 10000, 0 To 10)
   
8.     With Http
   
9.         .Open "POST", strURL, False
   
10.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
11.         .send "pageNumber=1&pageSize=10&waittype=2&num=0&shoulbahzh=&xingm=&idcard="
    
12.         strText = Split(Split(.responseText, "[")(1), "]")(0)
    
13.     End With
    
14.     R = Array("PAIX", "SHOULHZH", "XINGM", "SFZH", "RUHSJ", "SHOUCCBSJ_GZ", "QUA_DATE", "RZQK", "REMARK")
    
15.     With Dom.parentWindow
    
16.         Dom.write "<script> var data=[" & strText & "] </script>"
    
17.         For i = 0 To .eval("data.length") - 1
    
18.             Set cll = .eval("data[" & i & "]")
    
19.             k = k + 1
    
20.             For j = 0 To UBound(R)
    
21.                 arr(k, j) = CallByName(cll, R(j), VbGet)
    
22.             Next
    
23.             arr(k, 9) = CallByName(cll, "LHMC_ID", VbGet)
    
24.         Next
    
25.     End With
    
26.     For i = 1 To k
    
27.         With Http
    
28.             .Open "POST", "http://bzflh.szjs.gov.cn/TylhW/lhmcAction.do?method=queryDetailLhc" _
    
29.                 & "&lhmcId=" & arr(i, 9) _
    
30.                 & "&waittype=2", False
    
31.             .send
    
32.             strText = .responseText
    
33.             Debug.Print strText
    
34.             arr(i, 9) = Split(Split(strText, "户籍所在区：</b>")(1), "<")(0)
    
35.         End With
    
36.     Next
    
37.     ActiveSheet.UsedRange.offset(1).ClearContents
    
38.     Range("a2").Resize(k, UBound(arr, 2)) = arr
    
39.     MsgBox "查询OK"
    
40.     Set Http = Nothing
    
41.     Set Dom = Nothing
    
42. End Sub

复制代码

看见星光

附件参考 EH.rar (21.22 KB, 下载次数: 6)

2018-6-22 14:39 上传

点击文件名下载附件

看见星光

如果需要翻页紫星修改网页参数pageNumber，例如pageNumber=2等。