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

lsftest

原帖由 xmyjk 于 2011-1-28 20:43 发表
东莞的税票查询XMLHTTP方式也做好了
再次谢谢ISFTEST的帮助，真是网页高手啊，学习

哈哈。。。。惭愧。。。其实我对网页基本可说一窍不通的。。。
倒是想问问，有没有实际测试过，批量查询时，xmlhttp是否真比webbrowser或webquery快？如果快，大概快多少？

xmyjk

我有试过就是
如果是厦门国税的那个，不需要转码的，XMLHTTP确实比WEBBROWSER和WEBQUERY快得多
其他的，XMLHTTP比WEBBROWSER快，但是速度没有WEBQUERY稳定，WEBQUERY第一次慢后面非常快。

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

lsftest

原帖由 xmyjk 于 2011-1-28 21:23 发表
我有试过就是
如果是厦门国税的那个，不需要转码的，XMLHTTP确实比WEBBROWSER和WEBQUERY快得多

东莞国税的那个，XMLHTTP比WEBBROWSER快，但是速度没有WEBQUERY稳定，WEBQUERY第一次慢后面非常快。

哦。。。谢谢。。。
webbrowser要顾及图片之类的什么杂7杂8的东西，最慢是意料之中。。。
WEBQUERY也许是excel有自己的转码子程式，那么比我们用的效率高那也说得过去。。。。
不管怎样。。。问题解决了就好。。。。

Moneky

谢谢大侠们分享，收藏学习一下！

xmyjk

是啊，解决了，结贴了，谢谢各位咯：）

ngs139

有实用价值

xmyjk

响应部分网友要求，吧webquery方式的也传上来。
厦门和东莞的都做了。

xmyjk

没想到做着做着，网页查询的4种方式都做出来了
感叹个

厦门的，不需要POST数据的

1. Option Explicit
   
2. Sub chaxun()
   
3. Dim intnum As Integer
   
4. Dim i As Integer
   
5. Dim strdaima As String
   
6. Dim strhaoma As String
   
7. 
   
8. intnum = Application.WorksheetFunction.CountA([A:A])
   
9. For i = 1 To intnum - 1
   
10. Cells(2, 3).Value = "正在查询第" & i & "张"
    
11. Application.ScreenUpdating = False
    
12. strdaima = Cells(i + 1, 1).Value
    
13. strhaoma = Cells(i + 1, 2).Value
    
14. 
    
15. With ActiveSheet.QueryTables.Add(Connection:="URL;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, Destination:=Cells(1, 10))
    
16.      .Name = "第" & i & "张"
    
17.      .BackgroundQuery = False
    
18.      .AdjustColumnWidth = True
    
19.      .RefreshPeriod = 0
    
20.      .WebSelectionType = xlSpecifiedTables
    
21.      .WebFormatting = xlWebFormattingNone
    
22.      .WebTables = "13"
    
23.      .Refresh BackgroundQuery:=False
    
24. End With
    
25. 
    
26. Cells(i + 1, 4).Value = Cells(5, 12).Value
    
27. Cells(i + 1, 5).Value = Cells(6, 12).Value
    
28. Cells(i + 1, 6).Value = Cells(7, 12).Value
    
29. Cells(i + 1, 7).Value = Cells(8, 12).Value
    
30. Cells(i + 1, 8).Value = Cells(9, 12).Value
    
31. Cells(i + 1, 9).Value = Cells(11, 11).Value
    
32. Range("j1:o20").Clear
    
33. 
    
34. Application.ScreenUpdating = True
    
35. Next i
    
36. 
    
37. Cells(2, 3).Value = "查询完毕！"
    
38. MsgBox "OK"
    
39. Cells(2, 3).Value = "查询状态提示栏"
    
40. 
    
41. End Sub
    

复制代码

东莞的，需要POST数据的

1. Option Explicit
   
2. Sub chaxun()
   
3. Dim intnum As Integer
   
4. Dim i As Integer
   
5. Dim strdm As String
   
6. Dim strhm As String
   
7. Dim strdjh As String
   
8. Dim strmc As String
   
9. Dim strje As String
   
10. Dim strrq As String
    
11. Dim stra As String
    
12. 
    
13. intnum = Application.WorksheetFunction.CountA([A:A])
    
14. For i = 1 To intnum - 1
    
15. Application.ScreenUpdating = False
    
16. Cells(2, 7).Value = "正在查询第" & i & "张"
    
17. strdm = Cells(i + 1, 1).Value
    
18. strhm = Cells(i + 1, 2).Value
    
19. strdjh = Cells(i + 1, 3).Value
    
20. strmc = Cells(i + 1, 4).Value
    
21. strje = Cells(i + 1, 5).Value
    
22. strrq = Format(Cells(i + 1, 6).Value, "yyyy-mm-dd")
    
23. stra = URLEncode(strmc)
    
24. With ActiveSheet.QueryTables.Add(Connection:="URL;http://app.gd-n-tax.gov.cn/wssw/servlet/invoice_checking", Destination:=Range("J1"))
    
25.      .PostText = "fpdm=" & strdm & "&fphm=" & strhm & "&xhfswdjh=" & strdjh & "&xhfmc=" & stra & "&kpje=" & strje & "&kprq=" & strrq & "&INVOICE_CHECKING_CHECKCODE=2829&check_code=2829"
    
26.      .Name = "第" & i & "张"
    
27.      .BackgroundQuery = False
    
28.      .AdjustColumnWidth = True
    
29.      .RefreshPeriod = 0
    
30.      .WebSelectionType = xlSpecifiedTables
    
31.      .WebFormatting = xlWebFormattingNone
    
32.      .WebTables = "5"
    
33.      .Refresh BackgroundQuery:=False
    
34. End With
    
35. 
    
36. Cells(i + 1, 8).Value = Cells(3, 10).Value
    
37. Range("j1:j10").Clear
    
38. Application.ScreenUpdating = True
    
39. Next i
    
40. 
    
41. Cells(2, 7).Value = "查询完毕！"
    
42. MsgBox "OK"
    
43. Cells(2, 7).Value = "查询状态提示栏"
    
44. 
    
45. End Sub
    
46. 
    
47. 
    
48. Public Function URLEncode(strInput As String) As String
    
49. '-------------------------------------------------------
    
50. '示例: Debug.Print URLEncode("PowerBASIC中国")
    
51. '-------------------------------------------------------
    
52. Dim strOutput As String
    
53. Dim intAscii As Integer
    
54. Dim i As Integer
    
55. Dim strTemp As String
    
56. 
    
57. For i = 1 To Len(strInput)
    
58. intAscii = Asc(Mid(strInput, i, 1))
    
59. If ((intAscii < 58) And (intAscii > 47)) Or _
    
60. ((intAscii < 91) And (intAscii > 64)) Or _
    
61. ((intAscii < 123) And (intAscii > 96)) _
    
62. Then
    
63. strOutput = strOutput & Chr$(intAscii)
    
64. Else
    
65. strTemp = Trim$(Hex$(intAscii))
    
66. strOutput = strOutput & "%" & Left(strTemp, 2) & "%" & Right(strTemp, 2)
    
67. End If
    
68. Next
    
69. URLEncode = strOutput
    
70. End Function

复制代码

xmyjk

可以完美终结啦

execl

好东西，含金量较高！！