用EXCEL实现网页上批量查询发票(谢谢lsftest,xmlhttp,IE/webbrowser,webquery均做出)

xmyjk

谢谢，我也觉得我那个取字符串的过程太过冗长了
学习ING
自己找了贴
也发出来大家一起学习
http://www.officefans.net/cdb/vi ... &extra=page%3D1

青城山苦丁茶

留下脚印，进一步学习！

xmyjk

请教下ISFTEST
今天在帮东莞的朋友看看能不能用XMLHTTP的方式做发票查询
http://app.gd-n-tax.gov.cn/wssw/ ... _checking_input.jsp
想请教下，在XMLHTTP方式下，这个网站，我应该往哪里发送查询的数据呢？
试了好几个位置，好像都不行。
XMLHTTP的数据方式我要用POST还是用GET的呢？

lsftest

原帖由 xmyjk 于 2011-1-28 10:39 发表
请教下ISFTEST
今天在帮东莞的朋友看看能不能用XMLHTTP的方式做发票查询
http://app.gd-n-tax.gov.cn/wssw/ ... _checking_input.jsp
想请教下，在XMLHTTP方式下，这个网站， ...

看了一下，这个页面跟你那个不一样，如果非得用xmlhttp，一定得post，post到http://app.gd-n-tax.gov.cn/wssw/servlet/invoice_checking去，而且不能象你那样直接在连接里带上发票号发票码之类的参数，而是要在随后的send方法中作为参数发送出去。。。
没有测试过，只是随便说说。。。

xmyjk

试了一下，好像不行耶，麻烦看下。

1. Option Explicit
   
2. Sub chaxun()
   
3. Dim xmlhttp As Object
   
4. 
   
5. Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
   
6. xmlhttp.Open "post", "http://app.gd-n-tax.gov.cn/wssw/servlet/invoice_checking", False
   
7. xmlhttp.setRequestHeader "pragma", "no-cache"
   
8. xmlhttp.Send "fpdm=144001021134&fphm=07691076&xhfswdjh=441900L28192078&xhfmc=东莞市塘厦运凯五金电器商店&kpje=9002.0&kprq=2010-08-04&INVOICE_CHECKING_CHECKCODE=2829&check_code=2829"
   
9. Do Until xmlhttp.ReadyState = 4
   
10. DoEvents
    
11. Loop
    
12. 
    
13. If xmlhttp.Status = 200 Then
    
14.   Debug.Print xmlhttp.responseText
    
15. Else
    
16.   reportErr (xmlhttp.Status)
    
17. End If
    
18. 
    
19. End Sub
    
20. 
    
21. Sub reportErr(lStatus As Integer)
    
22.         Select Case lStatus
    
23.             Case 400
    
24.                 MsgBox "Bad Request", vbCritical, "连接错误"
    
25.             Case 401
    
26.                 MsgBox "Unauthorized", vbCritical, "连接错误"
    
27.             Case 402
    
28.                 MsgBox "Payment Required", vbCritical, "连接错误"
    
29.             Case 403
    
30.                 MsgBox "Forbidden", vbCritical, "连接错误"
    
31.             Case 404
    
32.                 MsgBox "Not Found", vbCritical, "连接错误"
    
33.             Case 407
    
34.               MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
    
35.             Case 408
    
36.                 MsgBox "Request Timeout", vbCritical, "连接错误"
    
37.             Case 503
    
38.                 MsgBox "Service Unavailable", vbCritical, "连接错误"
    
39.             Case Else
    
40.               MsgBox "Can not reach by other reason", vbCritical, "连接错误"
    
41.         End Select
    
42. End Sub

复制代码

[ 本帖最后由 xmyjk 于 2011-1-28 13:54 编辑 ]

lsftest

原帖由 xmyjk 于 2011-1-28 13:31 发表
试了一下，好像不行耶，麻烦看下。Option Explicit
Sub chaxun()
Dim xmlhttp As Object

Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.Open "post", "http://app.gd-n-tax.gov.cn/wssw/servlet/i ...

send这个看看：fpdm=00000000000&fphm=1111111&xhfswdjh=2222222222&xhfmc一堆莫名其妙的东西&kpje=285.0&kprq=2010-12-06&INVOICE_CHECKING_CHECKCODE=7690&check_code=7690
验证码自己改一下

[ 本帖最后由 lsftest 于 2011-1-28 14:40 编辑 ]

lsftest

xmlhttp.Open "post", "http://app.gd-n-tax.gov.cn/wssw/servlet/invoice_checking", False
xmlhttp.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
xmlhttp.Send "fpdm=1111111111111111&fphm=222222222&xhfswdjh=333333333333&xhfmc一堆莫名其妙的东西&kpje=285.0&kprq=2010-12-06&INVOICE_CHECKING_CHECKCODE=0401&check_code=0401"


这样就行了（验证码自己搞）。。。
不过。。上面那堆“莫名其妙的东西”，由于是中文。查询里带中文字就是麻烦，你得先进行处理，上网找找好象有个什么escpe什么之类的编码子程式，搬进来用就是了。。。。

[ 本帖最后由 lsftest 于 2011-1-28 14:44 编辑 ]

xmyjk

哇！厉害！谢谢了！
原来HTTP的头部信息设置有问题。
高手阿！

xmyjk

东莞的税票查询XMLHTTP方式也做好了
再次谢谢ISFTEST的帮助，真是网页高手啊，学习

[ 本帖最后由 xmyjk 于 2011-1-28 20:47 编辑 ]

xmyjk

1. Option Explicit
   
2. Sub chaxun()
   
3. Dim xmlhttp As Object
   
4. Dim intnum As Integer
   
5. Dim i As Integer
   
6. Dim strdm As String
   
7. Dim strhm As String
   
8. Dim strdjh As String
   
9. Dim strmc As String
   
10. Dim strje As String
    
11. Dim strrq As String
    
12. Dim stra As String
    
13. Dim getpage As String
    
14. Dim strjg As String
    
15. 
    
16. intnum = Application.WorksheetFunction.CountA([A:A])
    
17. For i = 1 To intnum - 1
    
18. Cells(2, 7).Value = "正在查询第" & i & "张"
    
19. strdm = Cells(i + 1, 1).Value
    
20. strhm = Cells(i + 1, 2).Value
    
21. strdjh = Cells(i + 1, 3).Value
    
22. strmc = Cells(i + 1, 4).Value
    
23. strje = Cells(i + 1, 5).Value
    
24. strrq = Format(Cells(i + 1, 6).Value, "yyyy-mm-dd")
    
25. 
    
26. Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
27. xmlhttp.Open "post", "http://app.gd-n-tax.gov.cn/wssw/servlet/invoice_checking", False
    
28. xmlhttp.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
    
29. stra = URLEncode(strmc)
    
30. xmlhttp.Send "fpdm=" & strdm & "&fphm=" & strhm & "&xhfswdjh=" & strdjh & "&xhfmc=" & stra & "&kpje=" & strje & "&kprq=" & strrq & "&INVOICE_CHECKING_CHECKCODE=2829&check_code=2829"
    
31. 
    
32. Do Until xmlhttp.ReadyState = 4
    
33. DoEvents
    
34. Loop
    
35. 
    
36. If xmlhttp.Status = 200 Then
    
37.   getpage = xmlhttp.responseText
    
38.   strjg = Mid(getpage, InStr(getpage, "查询结果") + 177, InStr(getpage, "如需进一步查验发票真伪") - InStr(getpage, "查询结果") - 266)
    
39.   Cells(i + 1, 8).Value = strjg
    
40. Else
    
41.   reportErr (xmlhttp.Status)
    
42. End If
    
43. 
    
44. Next i
    
45. 
    
46. Cells(2, 7).Value = "查询完毕！"
    
47. MsgBox "OK"
    
48. Cells(2, 7).Value = "查询状态提示栏"
    
49. 
    
50. End Sub
    
51. 
    
52. Sub reportErr(lStatus As Integer)
    
53.         Select Case lStatus
    
54.             Case 400
    
55.                 MsgBox "Bad Request", vbCritical, "连接错误"
    
56.             Case 401
    
57.                 MsgBox "Unauthorized", vbCritical, "连接错误"
    
58.             Case 402
    
59.                 MsgBox "Payment Required", vbCritical, "连接错误"
    
60.             Case 403
    
61.                 MsgBox "Forbidden", vbCritical, "连接错误"
    
62.             Case 404
    
63.                 MsgBox "Not Found", vbCritical, "连接错误"
    
64.             Case 407
    
65.               MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
    
66.             Case 408
    
67.                 MsgBox "Request Timeout", vbCritical, "连接错误"
    
68.             Case 503
    
69.                 MsgBox "Service Unavailable", vbCritical, "连接错误"
    
70.             Case Else
    
71.               MsgBox "Can not reach by other reason", vbCritical, "连接错误"
    
72.         End Select
    
73. End Sub
    
74. 
    
75. Public Function URLEncode(strInput As String) As String
    
76. '-------------------------------------------------------
    
77. '示例: Debug.Print URLEncode("PowerBASIC中国")
    
78. '-------------------------------------------------------
    
79. Dim strOutput As String
    
80. Dim intAscii As Integer
    
81. Dim i As Integer
    
82. Dim strTemp As String
    
83. 
    
84. For i = 1 To Len(strInput)
    
85. intAscii = Asc(Mid(strInput, i, 1))
    
86. If ((intAscii < 58) And (intAscii > 47)) Or _
    
87. ((intAscii < 91) And (intAscii > 64)) Or _
    
88. ((intAscii < 123) And (intAscii > 96)) _
    
89. Then
    
90. strOutput = strOutput & Chr$(intAscii)
    
91. Else
    
92. strTemp = Trim$(Hex$(intAscii))
    
93. strOutput = strOutput & "%" & Left(strTemp, 2) & "%" & Right(strTemp, 2)
    
94. End If
    
95. Next
    
96. URLEncode = strOutput
    
97. End Function

复制代码