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

oknrviil  于 2023-04-07  发布在  其他
关注(0)|答案(2)|浏览(149)

我正在尝试使用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提供的代理处理...

w1jd8yoj

w1jd8yoj1#

不需要使用自定义库,试试这个

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
ggazkfy8

ggazkfy82#

注意:如果您收到错误消息**“编译错误:必须更新此项目中的代码才能在64位系统上使用。请检查并更新Declare语句,然后用PtrSafe属性”标记它们。**
Image of this prompted error massage

尝试将PtrSafe关键字添加到Declare语句可能会有所帮助。
例如,将上面的代码段更改为

Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _

这也适用于Excel 2016 64位。
参考:https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/ptrsafe-keyword

相关问题