ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何用VBA下载国税法规库

如何用VBA下载国税法规库

作者:绿色风 分类: 时间:2022-08-17 浏览:107
楼主
xmyjk
Q:如何获取税务总局网站法规库的所有法规,另存为HTML格式,并超链接到EXEL做目录。      
网址:http://202.108.90.171:9090/guoshui/main.jsp

A:思路:先利用国税网站开放的端口,下载全部的目录,然后依据目录,下载每个法规的页面。
  1. Option Explicit
  2. Dim tmp() As String

  3. Sub rn()
  4.     Dim xmlhttp As Object
  5.     On Error GoTo cc
  6.     Set xmlhttp = CreateObject("Microsoft.XMLHTTP") '建立XMLHTTP对象
  7.     With xmlhttp
  8.         .Open "get", "http://202.108.90.171:9090/guoshui/action/InitNewArticle.do?shuizhong=%E5%85%A8%E9%83%A8%E6%B3%95%E8%A7%84&articleRole=&articleField08=&articleField09=&articleField10=&articleField11=&articleField12=&articleField13=&articleField14=&articleField18=&intvalue=1&intvalue1=1&initFlag=0&articleField01=&articleField03=&articleField04=&articleField05=&articleField06=&articleField07_s=&articleField07_d=&pageSize=13000&cPage=1", False
  9. '下载13000条的目录页
  10.         .send
  11.         If xmlhttp.Status <> 200 Then GoTo cc '如果返回非200(获取成功)则重新运行
  12.         tmp = Filter(Split(.responsetext, "</a></td>"), "<a href=""..") '取目录切到数组里面
  13.     End With
  14.     t 0
  15. cc:
  16.     rn
  17. End Sub

  18. Sub t(p As Long)
  19.     Dim i&, arr() As String, xmlhttp As Object

  20.     ReDim arr(UBound(tmp), 1)
  21.     Set xmlhttp = CreateObject("Microsoft.XMLHTTP") '建立对象
  22.     On Error GoTo line1
  23.     For i = 0 To UBound(tmp) '历遍目录数据,以下均是整理链接
  24.         tmp(i) = Split(tmp(i), "<a href=""..")(1)
  25.         arr(i, 0) = "http://202.108.90.171:9090/guoshui" & Split(tmp(i), """")(0)
  26.         arr(i, 1) = Split(tmp(i), ">")(1)
  27.         With xmlhttp
  28.             .Open "get", arr(i, 0), False '获取每条法规的源代码
  29.             .send
  30.             If xmlhttp.Status <> 200 Then GoTo line1
  31.             With CreateObject("ADODB.Stream") '创建ADODB.STREAM对象
  32.                 .Type = 1
  33.                 .Open
  34.                 .write xmlhttp.Responsebody '写入
  35.                 .savetofile ThisWorkbook.Path & "\库\" & i & ".html", 2 '二进制数据流保存为HTML文件
  36.                 .Close
  37.             End With
  38.         End With
  39.         Application.ScreenUpdating = False
  40.         ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 1), Address:="库\" & arr(i, 1) & ".html", TextToDisplay:=arr(i, 1) '在工作簿建立超链接
  41.         Application.ScreenUpdating = True
  42.     Next
  43.     Sheets("库").[a2].Resize(UBound(arr) + 1, UBound(arr, 2) + 1) = arr
  44.     Erase tmp
  45.     Erase arr
  46.     Set xmlhttp = Nothing
  47. line1:
  48.     t i
  49. End Sub



国税下载.zip
2楼
い卋玑┾宝珼
妃妃好V5
3楼
houtian23
真厉害
我VBA连入门都不算啊
4楼
老糊涂
学习

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap