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

xmyjk · 发表于 2011-1-27 22:41

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

青城山苦丁茶 · 发表于 2011-1-27 23:32

留下脚印，进一步学习！

xmyjk · 发表于 2011-1-28 10:39

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

lsftest · 发表于 2011-1-28 11:54

原帖由 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 · 发表于 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/invoice_checking", False
xmlhttp.setRequestHeader "pragma", "no-cache"
xmlhttp.Send "fpdm=144001021134&fphm=07691076&xhfswdjh=441900L28192078&xhfmc=东莞市塘厦运凯五金电器商店&kpje=9002.0&kprq=2010-08-04&INVOICE_CHECKING_CHECKCODE=2829&check_code=2829"
Do Until xmlhttp.ReadyState = 4
DoEvents
Loop
If xmlhttp.Status = 200 Then
Debug.Print xmlhttp.responseText
Else
reportErr (xmlhttp.Status)
End If
End Sub
Sub reportErr(lStatus As Integer)
Select Case lStatus
Case 400
MsgBox "Bad Request", vbCritical, "连接错误"
Case 401
MsgBox "Unauthorized", vbCritical, "连接错误"
Case 402
MsgBox "Payment Required", vbCritical, "连接错误"
Case 403
MsgBox "Forbidden", vbCritical, "连接错误"
Case 404
MsgBox "Not Found", vbCritical, "连接错误"
Case 407
MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
Case 408
MsgBox "Request Timeout", vbCritical, "连接错误"
Case 503
MsgBox "Service Unavailable", vbCritical, "连接错误"
Case Else
MsgBox "Can not reach by other reason", vbCritical, "连接错误"
End Select
End Sub

复制代码

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

lsftest · 发表于 2011-1-28 14:12

原帖由 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 · 发表于 2011-1-28 14:39

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 · 发表于 2011-1-28 16:02

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

xmyjk · 发表于 2011-1-28 20:43

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

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

xmyjk · 发表于 2011-1-28 20:45

Option Explicit
Sub chaxun()
Dim xmlhttp As Object
Dim intnum As Integer
Dim i As Integer
Dim strdm As String
Dim strhm As String
Dim strdjh As String
Dim strmc As String
Dim strje As String
Dim strrq As String
Dim stra As String
Dim getpage As String
Dim strjg As String
intnum = Application.WorksheetFunction.CountA([A:A])
For i = 1 To intnum - 1
Cells(2, 7).Value = "正在查询第" & i & "张"
strdm = Cells(i + 1, 1).Value
strhm = Cells(i + 1, 2).Value
strdjh = Cells(i + 1, 3).Value
strmc = Cells(i + 1, 4).Value
strje = Cells(i + 1, 5).Value
strrq = Format(Cells(i + 1, 6).Value, "yyyy-mm-dd")
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.Open "post", "http://app.gd-n-tax.gov.cn/wssw/servlet/invoice_checking", False
xmlhttp.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
stra = URLEncode(strmc)
xmlhttp.Send "fpdm=" & strdm & "&fphm=" & strhm & "&xhfswdjh=" & strdjh & "&xhfmc=" & stra & "&kpje=" & strje & "&kprq=" & strrq & "&INVOICE_CHECKING_CHECKCODE=2829&check_code=2829"
Do Until xmlhttp.ReadyState = 4
DoEvents
Loop
If xmlhttp.Status = 200 Then
getpage = xmlhttp.responseText
strjg = Mid(getpage, InStr(getpage, "查询结果") + 177, InStr(getpage, "如需进一步查验发票真伪") - InStr(getpage, "查询结果") - 266)
Cells(i + 1, 8).Value = strjg
Else
reportErr (xmlhttp.Status)
End If
Next i
Cells(2, 7).Value = "查询完毕！"
MsgBox "OK"
Cells(2, 7).Value = "查询状态提示栏"
End Sub
Sub reportErr(lStatus As Integer)
Select Case lStatus
Case 400
MsgBox "Bad Request", vbCritical, "连接错误"
Case 401
MsgBox "Unauthorized", vbCritical, "连接错误"
Case 402
MsgBox "Payment Required", vbCritical, "连接错误"
Case 403
MsgBox "Forbidden", vbCritical, "连接错误"
Case 404
MsgBox "Not Found", vbCritical, "连接错误"
Case 407
MsgBox "Proxy Authentication Required", vbCritical, "连接错误"
Case 408
MsgBox "Request Timeout", vbCritical, "连接错误"
Case 503
MsgBox "Service Unavailable", vbCritical, "连接错误"
Case Else
MsgBox "Can not reach by other reason", vbCritical, "连接错误"
End Select
End Sub
Public Function URLEncode(strInput As String) As String
'-------------------------------------------------------
'示例: Debug.Print URLEncode("PowerBASIC中国")
'-------------------------------------------------------
Dim strOutput As String
Dim intAscii As Integer
Dim i As Integer
Dim strTemp As String
For i = 1 To Len(strInput)
intAscii = Asc(Mid(strInput, i, 1))
If ((intAscii < 58) And (intAscii > 47)) Or _
((intAscii < 91) And (intAscii > 64)) Or _
((intAscii < 123) And (intAscii > 96)) _
Then
strOutput = strOutput & Chr$(intAscii)
Else
strTemp = Trim$(Hex$(intAscii))
strOutput = strOutput & "%" & Left(strTemp, 2) & "%" & Right(strTemp, 2)
End If
Next
URLEncode = strOutput
End Function

复制代码

		自动登录	找回密码
密码			免费注册

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

回复 50楼 lsftest 的帖子

回复 44楼 lsftest 的帖子

回复 54楼 lsftest 的帖子

回复 57楼 lsftest 的帖子

回复 57楼 lsftest 的帖子

东莞的查询代码如下