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

xmyjk · 发表于 2011-1-11 20:23

明白，好的，受教了，谢谢了

120HYH · 发表于 2011-1-11 20:26

我的意思只是取数，不弹出网页。就是这样。哈哈。

wkbu · 发表于 2011-1-11 20:49

留下脚印，进一步学习！

lsftest · 发表于 2011-1-11 20:59

原帖由 120HYH 于 2011-1-11 20:26 发表
我的意思只是取数，不弹出网页。就是这样。哈哈。

呵呵，走运，那网站服务器没有再校验验证码，省了很多事。。。按上面连接里说的在excel里用webquery应该很轻松就搞好了吧。。
既然可以绕过验证码，如果想提高速度，也是和给楼主的建议一样，使用xmlhttp去搞，速度会快很多。。。具体方法上网找找，我就不说了。。
最后还是那句，那是政府网站，不要干坏事，否则我也成帮凶了。。。批量查询也最好选在网络非繁忙时间去做。。。

xmyjk · 发表于 2011-1-11 21:06

呵呵，明白了
放心，我们也是按政府的要求，去查验客户的发票的真实性，才不得不去查询的
只是一次要查好几百张，那个工作量实在恐怖，而且查完了还要打印存档
现在有了工具，后勤人员只要存电子档或仅仅打印EXcel文档，又环保
谢谢了。

120HYH · 发表于 2011-1-11 21:17

XMYJK兄帮我搞出来。省事啊。我不会弄这玩艺

120HYH · 发表于 2011-1-13 20:07

有会弄的朋友不？

xmyjk · 发表于 2011-1-27 14:20

抽空研究了下XMLHTTP的做法，成功做出来了，如附件
也感谢lsftest的指点。

[ 本帖最后由 xmyjk 于 2011-1-27 14:37 编辑 ]

xmyjk · 发表于 2011-1-27 14:40

Option Explicit
Sub chaxun()
Dim xmlhttp As Object
Dim intnum As Integer
Dim i As Integer
Dim strdaima As String
Dim strhaoma As String
Dim getpage As String
Dim stra As String
Dim strb(4) As String
intnum = Application.WorksheetFunction.CountA([A:A])
For i = 1 To intnum - 1
Cells(2, 3).Value = "正在查询第" & i & "张"
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
strdaima = Cells(i + 1, 1).Value
strhaoma = Cells(i + 1, 2).Value
xmlhttp.Open "get", "http://www.xm-n-tax.gov.cn/BrowseServlet?szsat.trancode=101007&szsat.errpage=%2Fjsp%2Finternet%2Findex%2FerrPage.jsp&szsat.normalpage=%2Fjsp%2Finternet%2Finforservice%2Fidentifyout.jsp&szsat.fpzw.fplx=&szsat.fpzw.fpdm=" & strdaima & "&szsat.fpzw.fphm=" & strhaoma, False
xmlhttp.setRequestHeader "Content-Type", "text/html"
xmlhttp.Send ""
Do Until xmlhttp.ReadyState = 4
DoEvents
Loop
If xmlhttp.Status = 200 Then
getpage = xmlhttp.responseText
stra = Replace(Mid(getpage, InStr(getpage, "纳税人识别号："), InStr(getpage, "</font></td>") - InStr(getpage, "纳税人识别号：")), "src=" & Chr(34) & "/jsp/internet/images/main_reddian.gif" & Chr(34) & " width=" & Chr(34) & "6" & Chr(34) & " height=" & Chr(34) & "10" & Chr(34) & ">", "[")
strb(0) = Replace(Split(stra, "[")(0), "</td>", "]")
strb(1) = Replace(Split(stra, "[")(1), "</td>", "]")
strb(2) = Replace(Split(stra, "[")(2), "</td>", "]")
strb(3) = Replace(Split(stra, "[")(3), "</td>", "]")
strb(4) = Replace(Split(stra, "[")(4), "</td>", "]")
Cells(i + 1, 4).Value = Trim(Mid(Split(strb(0), "]")(1), InStr(Split(strb(0), "]")(1), ">") + 1, Len(Split(strb(0), "]")(1))))
Cells(i + 1, 5).Value = Trim(Mid(Split(strb(1), "]")(1), InStr(Split(strb(1), "]")(1), ">") + 1, Len(Split(strb(1), "]")(1))))
Cells(i + 1, 6).Value = Trim(Mid(Split(strb(2), "]")(1), InStr(Split(strb(2), "]")(1), ">") + 1, Len(Split(strb(2), "]")(1))))
Cells(i + 1, 7).Value = Trim(Mid(Split(strb(3), "]")(1), InStr(Split(strb(3), "]")(1), ">") + 1, Len(Split(strb(3), "]")(1))))
Cells(i + 1, 8).Value = Trim(Mid(Split(strb(4), "]")(1), InStr(Split(strb(4), "]")(1), ">") + 1, Len(Split(strb(4), "]")(1))))
Cells(i + 1, 9).Value = Trim(Mid(Split(strb(4), "]")(3), InStr(Split(strb(4), "]")(3), "0000") + 7, InStr(Split(strb(4), "]")(3), "！") - InStr(Split(strb(4), "]")(3), "0000") - 6))
Set xmlhttp = Nothing
getpage = Empty
Else
reportErr (xmlhttp.Status)
End If
Next i
Cells(2, 3).Value = "查询完毕！"
MsgBox "OK"
Cells(2, 3).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

复制代码

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

lsftest · 发表于 2011-1-27 17:35

原帖由 xmyjk 于 2011-1-27 14:40 发表
Sub chaxun()
Dim xmlhttp As Object, objstream As Object
Dim intnum As Integer
Dim i As Integer
Dim strdaima As String
Dim strhaoma As String
Dim getpage As String
Dim stra As String
Dim strb() ...

呵呵，恭喜恭喜。。。
如果有时间想进一步优化，就看看正则表达式的东西吧，对数据提取有很大帮助，语句会简洁很多。。

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

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

回复 39楼 lsftest 的帖子

我的意思是取数，不弹出网页。就是这样。哈哈。

回复 44楼 lsftest 的帖子

XMYJK兄帮我搞出来。省事啊。我不会弄这玩艺

有会弄的朋友不？

研究了下XMLHTTP的做法

代码如下