网上批量查询发票

好好23

谁有 发票批量下载软件， 联系我QQ2717783764

好好23

谁有 批量发票下载软件， 联系我QQ2717783764

山谷離的居民

北京的点“试试看”显示编译错误?

huabeihaotianhj

咋回事呀。菜鸟求学！

huabeihaotianhj

kangatang 发表于 2013-2-20 11:32
在这个验证码横行的时代，不自动识别验证码，已经失去批量处理的意义。

感谢蓝天老师的辛苦佳作，击破了 ...

请教高手咋回事呢？这是...

lcjy11185

水平真高啊

rz83305

蓝老师，广东地税的网站更改成：http://www.gd-n-tax.gov.cn/pub/gdgsww/bsfw/sscx/fpcy/  不知应改那里？

白马胖子

高手啊，立即跪学

缔造者

河南国税发票查询无反应，河南国税发票查询地址有变化：http://www.12366.ha.cn/003/bsfw_302/sscx_30202/index.html，求楼主更新。
河南地税发票查询地址：http://wsdt.ha-l-tax.gov.cn/sword?ctrl=WwSscxFpzwcxCtrl_init，求楼主增加。
谢谢！

z149779081

新疆地税的不能使用
经过小小的改动后不会出错了，但是只能把第一条数据自动填充到自动打开的网页中，仅限第一条
新疆地税也会出错
经过研读所给的代码，在进行小小的改动后可以使用了
改后的代码如下：

1. Private Sub CommandButton1_Click()    '新疆国税查询
   
2.     Dim sends As String
   
3.     n = Range("a65536").End(xlUp).Row
   
4.     For p = 2 To n
   
5.         send1 = "zwcxxh=&fplb=1&fpdm=" & Cells(p, 1) & "&fphm=" & Cells(p, 2) & "&kpje=" & Cells(p, 3)
   
6.         With CreateObject("WinHttp.WinHttpRequest.5.1")
   
7.             .Open "GET", "http://www.xj-n-tax.gov.cn/zxbs/sscx/fpzwch/", False
   
8.             .send
   
9. 
   
10.             .Open "POST", "http://www.xj-n-tax.gov.cn:8001/sspt_web/pages/fpyw/fpywFpywcxAction.action?oper=QUERY", False
    
11.             .setRequestHeader "Referer", "http://www.xj-n-tax.gov.cn:8001/sspt_web/pages/fpyw/fpywFpywcxAction.action?oper=QUERY"
    
12.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
13.             .setRequestHeader "Connection", "Keep-Alive"
    
14.             .send send1
    
15.             tt = .responsetext
    
16.             With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
17.                 .SetText tt
    
18.             End With
    
19.             If InStr(tt, "查询结果：") Then
    
20.                  Cells(p, 4) = "该发票有问题，请手动核查！"
    
21.             Else
    
22.             Cells(p, 4) = Replace(Split(Split(Split(tt, "fpywFpywcxAction_xhfsh")(1), ">")(1), "<")(0), vbCrLf, "")
    
23.             Cells(p, 5) = Replace(Split(Split(Split(tt, "fpywFpywcxAction_xhfmc")(1), ">")(1), "<")(0), vbCrLf, "")
    
24.             Cells(p, 6) = Replace(Split(Split(Split(tt, "fpywFpywcxAction_hwmc")(1), ">")(1), "<")(0), vbCrLf, "")
    
25.             End If
    
26.         End With
    
27.     Next p
    
28. End Sub

复制代码

office2007环境中运行最后的效果如下：