VBA-Web下载图像并保存到文件夹

时间:2018-08-15 12:18:54

标签: vba excel-vba

我正在尝试使用VBA-Web库(https://github.com/VBA-tools/VBA-Web)下载图像并将其保存到我的计算机中。

这段代码可以正常工作,但是我想检查一下正确的方法来完成工作。 VBA不是我的主要经验。

Sub Run()

    Dim client As New WebClient
    With client
        .BaseUrl = "http://chart.apis.google.com/chart?cht=qr&chs=160x160&chld=L|0&chl=hello"
        .EnableAutoProxy = True
    End With

    Dim request As New WebRequest
    With request
        .Method = WebMethod.HttpGet
        .AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    End With

    Dim Response As WebResponse
    Set Response = client.Execute(request)

    ProcessResponse Response

End Sub

Sub ProcessResponse(Response As WebResponse)

    Dim oStream As Object

    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write Response.Body
    oStream.SaveToFile Environ("USERPROFILE") & "\Desktop\image_test.png", 2
    oStream.Close

End Sub

我使用了其他各种下载方法,并且可以使用XMLHTTP和URLDownloadToFile,但是由于网络问题,我需要VBA-Web提供的代理处理...

2 个答案:

答案 0 :(得分:1)

无需使用自定义库,请尝试

Public Declare Function URLDownloadToFile Lib "urlmon" Alias _
   "URLDownloadToFileA" (ByVal pCaller As Long, _
   ByVal szURL As String, _
   ByVal szFileName As String, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long

Public Sub GURoL(url As String, FileName As String)
Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, url, FileName, 0, 0)
    If lngRetVal <> 0 Then
    MsgBox "GURol godo: Can't download from " & url & " to " & FileName
    End If
End Sub

Sub Download_Procedure()
Call GURoL("http://i.msdn.microsoft.com/ms348103.LOGO_WINDOWS(en-us,MSDN.10).png", _
           "c:\Temp\plik.png") '<change your dest. path
End Sub

答案 1 :(得分:0)

注意:如果遇到错误提示“编译错误:必须更新此项目中的代码以在64位系统上使用。请查看并更新Declare语句,然后将其标记为PtrSafe属性” Image of this prompted error massage

尝试将PtrSafe关键字添加到Declare语句中可能会有帮助。

例如,将上面的代码片段更改为

Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _

这也适用于Excel 2016 64位。

参考:https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/ptrsafe-keyword