网抓下载验证码报错

xinxincheng

下载这个验证码到本地，现金答谢好心人
url = "https://amr.sz.gov.cn/outer/validate/getCode.do?timestamp=" & Rnd()

1. Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Long
   
2. 
   
3. 'https://amr.sz.gov.cn/outer/entSelect/gs.html
   
4. Sub Djpg1()
   
5.     Dim Url As String
   
6.     Dim Path As String
   
7. 
   
8.         Path = ThisWorkbook.Path: ChDrive (Path): ChDir (Path)
   
9.         Path = Path & "\xcode.jpg"
   
10. 
    
11.         Url = "https://amr.sz.gov.cn/outer/validate/getCode.do?timestamp=" & Rnd()
    
12.         URLDownloadToFile 0, Url, Path & "\xcode.jpg", 0, 0
    
13. 
    
14. End Sub
    
15. '===========================================================
    
16. '====================方法1下载不成功
    
17. '===========================================================
    
18. 
    
19. 
    
20. 
    
21. 
    
22. 
    
23. 'url = "https://amr.sz.gov.cn/outer/validate/getCode.do?timestamp=" & Rnd()
    
24. Sub Djpg2()
    
25.     Dim Url As String
    
26.     Dim FilePath As String
    
27.    
    
28.     Url = "https://amr.sz.gov.cn/outer/validate/getCode.do?timestamp=1576573885"
    
29.     FilePath = ThisWorkbook.Path: ChDrive (FilePath): ChDir (FilePath)
    
30.     FilePath = FilePath & "\xcode.jpg"
    
31.    
    
32.     DownloadImage Url, FilePath
    
33. 
    
34. End Sub
    
35. 
    
36. Function DownloadImage(Url As String, FilePath As String) As Boolean
    
37.     Dim httpReq As Object
    
38.     On Error GoTo ErrorHandler
    
39.     Set httpReq = CreateObject("MSXML2.XMLHTTP")
    
40.     With httpReq
    
41.         .Open "GET", Url, False
    
42.         .Send
    
43.     End With
    
44.     If httpReq.Status = 200 Then
    
45.         With CreateObject("ADODB.Stream")
    
46.             .Open
    
47.             .Type = 1
    
48.             .Write httpReq.ResponseBody
    
49.             .SaveToFile FilePath, 2
    
50.             .Close
    
51.         End With
    
52.         DownloadImage = True
    
53.     Else
    
54.         DownloadImage = False
    
55.     End If
    
56.     Exit Function
    
57. ErrorHandler:
    
58.     DownloadImage = False
    
59. End Function
    
60. '===========================================================
    
61. '====================方法2下载不成功
    
62. '===========================================================
    
63. 
    

复制代码

静听溪流

你试试改改看 行不行   我64位系统的  可以正常运行

1. Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szExtName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
   
2. Sub DownloadaAttachment()
   
3.     Dim strURL As String
   
4.     Dim strPath As String
   
5.     Dim intRetVal As Integer
   
6.     strURL = "https://amr.sz.gov.cn/outer/validate/getCode.do?timestamp=" & Rnd()
   
7.     strPath = ThisWorkbook.Path & "\3.jpg"
   
8.     intRetVal = URLDownloadToFile(0, strURL, strPath, 0, 0)
   
9.     If intRetVal = 0 Then
   
10.         MsgBox "下载成功！"
    
11.     Else
    
12.         MsgBox "下载失败！"
    
13.     End If
    
14. End Sub

复制代码

静听溪流

箭头地方需要修改下

xinxincheng

静听溪流 发表于 2024-1-11 19:54
箭头地方需要修改下

报错显示溢出，呜呜呜

xinxincheng

静听溪流 发表于 2024-1-11 19:54
箭头地方需要修改下

? URLDownloadToFile(0, strURL, strPath, 0, 0)

intRetVal=-2146697208

xinxincheng

报错 -2146697208 800c0008

tmplinshi

xinxincheng

tmplinshi 发表于 2024-1-12 11:34

失败。Status 返回值 412，老师我需求不大，一天查询一次就行，可以解答下吗？

tmplinshi

我测试是成功的。你有修改代码，换成其他的网址了吗？

perfect131

没有那么复杂 URLDownloadToFile  贼慢不推荐用
参考 6 楼
https://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1614851&pid=10887858

网站有反爬机制，所以不要玩火