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

xmyjk

由于东莞地税有验证码的变动，重新做了，代码如下。

1. Option Explicit
   
2. Sub Test()
   
3.     Dim tmp() As String, i As Integer, arr() As String, xmlhttp As Object, N As Long, TMP1() As String, NM As Long, p As Long, k As Integer, Fpdm(1 To 10) As String, Fphm(1 To 10) As String
   
4.     Dim Url As String, yzm As String, nyzm As String
   
5.                               
   
6.     N = [a65536].End(xlUp).Row
   
7.     NM = Application.Ceiling((N - 1) / 10, 1)
   
8.    
   
9.     For p = 1 To NM
   
10.      
    
11.     Cells(2, 3).Value = "正在查询，稍等..."
    
12.      
    
13.      For k = 1 To 10
    
14.         Fpdm(k) = Cells((p - 1) * 10 + k + 1, 1).Value
    
15.         Fphm(k) = Cells((p - 1) * 10 + k + 1, 2).Value
    
16.      Next k
    
17.      
    
18.      For k = 1 To 10
    
19.         Url = Url & "&fpdm" & k & "=" & Fpdm(k) & "&fphm" & k & "=" & Fphm(k)
    
20.      Next k
    
21.      
    
22.      Erase Fpdm
    
23.      Erase Fphm
    
24.      
    
25.      Url = "http://www.dgds.gov.cn/wssw/fpcjController.do?cmd=fpcjcheck" & Url
    
26.      
    
27.      Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
28.      With xmlhttp
    
29.         .Open "get", "http://www.dgds.gov.cn/wssw/jsp/yzmForCommonQuery.jsp", False
    
30.         .send
    
31.         yzm = Split(Split(.responsetext, "checkcode")(2), ".png")(0)
    
32.         nyzm = cyzm(yzm)
    
33.      End With
    
34.      Url = Url & "&yzm=" & nyzm
    
35.          
    
36.      With xmlhttp
    
37.         .Open "get", Url, False
    
38.         .send
    
39.         tmp() = Split(Replace(Replace(Replace(.responsetext, vbCrLf, ""), "</span>", ""), "&#160;", ""), "<td description=")
    
40.      End With
    
41.      ReDim arr(UBound(tmp) \ 7, 6)
    
42.      For i = 1 To UBound(tmp)
    
43.         TMP1() = Split(Split(tmp(i), "</td>")(0), ">")
    
44.         arr((i - 1) \ 7, (i - 1) Mod 7) = TMP1(UBound(TMP1))
    
45.         Erase TMP1
    
46.      Next i
    
47.    
    
48.      Cells((p - 1) * 10 + 2, 4).Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1) = arr
    
49.    
    
50.      Erase tmp
    
51.      Erase TMP1
    
52.      Erase arr
    
53.      Set xmlhttp = Nothing
    
54.      Url = ""
    
55.    
    
56.     Next p
    
57.    
    
58.     Cells(2, 3).Value = "查询状态栏"
    
59.    
    
60.     [D:J].Columns.AutoFit
    
61.     MsgBox "Ok"
    
62. 
    
63. End Sub
    
64. 
    
65. Function cyzm(yzm As String) As String
    
66. Dim c As Integer, d(1 To 4) As String
    
67. 
    
68. For c = 1 To 4
    
69.   If Val(Mid(yzm, c, 1)) - c >= 0 Then
    
70.      d(c) = Trim(Str(Val(Mid(yzm, c, 1)) - c))
    
71.   Else
    
72.      d(c) = Trim(Str(Val(Mid(yzm, c, 1)) - c + 10))
    
73.   End If
    
74. Next
    
75. 
    
76. cyzm = Join(d(), "")
    
77. End Function

复制代码

[ 本帖最后由 xmyjk 于 2011-5-20 23:36 编辑 ]

xmyjk

东莞地税的新附件，大家试看看。

[ 本帖最后由 xmyjk 于 2011-5-20 23:37 编辑 ]

plasma3300

神贴，长见识了，非常有帮助。学习了，感谢楼上的诸位老师。

ugyun

老师，能不能帮忙弄个湖北省国税查询的工具呀？http://swcx.hb-n-tax.gov.cn/hbgs/invoice/

xmyjk

原帖由 ugyun 于 2011-6-20 12:48 发表
老师，能不能帮忙弄个湖北省国税查询的工具呀？http://swcx.hb-n-tax.gov.cn/hbgs/invoice/

这个搞不定，图片验证码的，爱莫能助呀。

bingooo82

大侠，请问能够将验证码图片直接读取或下载到excel窗体中吗？
例如广东地税的“电子发票数据查询”：http://www.gdltax.gov.cn/portal/ ... BE70PDDIHG1YLWU.htm

网站查询，有时超时或网络问题出错了，又要重新输入，比较痛苦，在excel做起码不用重输发票资料，不知有没限定查询10条数据一个验证码？没限制的话就好了

它的网站现在除了电子发票的是图片验证码外，其余的查询暂时还是之前的数字形式。

[ 本帖最后由 bingooo82 于 2011-6-21 18:13 编辑 ]

gfs57

原帖由 xmyjk 于 2011-1-8 18:08 发表
已经整理完毕，已建电梯了哈。

由于工作性质，经常要查验发票
需要在厦门国税（http://www.xm-n-tax.gov.cn/nsfw/fpcx/fpzwcx/）这个网站里面查询发票状况
由于发票量每次都很大，一张一张手工查非常费时间，效 ...

偶遇，来的早不如来得巧 ! 留个记号，日后肯定有用。

bmdsjxyw

真好想学习这方面的知识，谢谢了！

ugyun

能不能实现用EXCEL实现网页上批量跟踪查询EMS邮件包裹发送状态呀？相信这个也有很多人需要的

pc_12

前几天这个网页还能输入数据，可不知怎么了这几天就不行了，求高手帮看一下，先谢了。