使用 Excel vba，将 Web 图像保存到磁盘

Posted 2023-05-07

【中文标题】使用 Excel vba，将 Web 图像保存到磁盘

【英文标题】：With Excel vba, save web image to disk

【发布时间】：2015-07-11 17:09:10

【问题描述】：

我正在尝试使用 excel vba 从网页中保存图像。 我设法得到了字符串（虽然不是我想要的），并且需要将它保存到磁盘。

源代码的 html 代码是：

<img id="SkuPageMainImg" data-sku="491215"  class="skuImageSTD" src="/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA" data-zoomimage="//www.staples.no/content/images/product/491215_1_xnl.jpg" data-resizeimage="&quot;0to1024&quot;:&quot;/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA&quot;,&quot;1025to1450&quot;:&quot;//www.staples.no/content/images/product/491215_1&quot;" data-screensize="">

我的代码是：IMG = .document.getElementById("SkuPageMainImg").src

这段代码捕获了src=之后的url：

/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA"

这样就可以了，但我更愿意捕捉的是data-zoomimage= 之后的网址： "//www.staples.no/content/images/product/491215_1_xnl.jpg"

无论哪种方式，我想要完成的是让 Excel VBA 将图像保存到我磁盘上的文件中 - 通常是 c:\folder\image_name.jpg

有人知道执行此操作的代码吗？

【参考方案1】：

导入URLDownloadToFile函数，直接使用。以下是完整的模块代码表，包括顶部的声明部分。该例程需要从第 2 行开始的 A 列中的完整 img src URL 列表。例如：http://www.staples.no/content/images/product/491215_1_xnm.jpg

        

Option Explicit

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr _
      ) As Long
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#Else
    Private 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
    Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
      Alias "DeleteUrlCacheEntryA" ( _
        ByVal lpszUrlName As String _
      ) As Long
#End If

Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000

Sub dlStaplesImages()
    Dim rw As Long, lr As Long, ret As Long, sIMGDIR As String, sWAN As String, sLAN As String

    sIMGDIR = "c:\folder"
    If Dir(sIMGDIR, vbDirectory) = "" Then MkDir sIMGDIR

    With ActiveSheet    '<-set this worksheet reference properly!
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        For rw = 2 To lr

            sWAN = .Cells(rw, 1).Value2
            sLAN = sIMGDIR & Chr(92) & Trim(Right(Replace(sWAN, Chr(47), Space(999)), 999))

            Debug.Print sWAN
            Debug.Print sLAN

            If CBool(Len(Dir(sLAN))) Then
                Call DeleteUrlCacheEntry(sLAN)
                Kill sLAN
            End If

            ret = URLDownloadToFile(0&, sWAN, sLAN, BINDF_GETNEWESTVERSION, 0&)

            .Cells(rw, 2) = ret
            Next rw
    End With

End Sub

值为 0 表示 B 列成功（例如 ERROR_SUCCESS）。

        

【讨论】：

非常感谢。像梦一样工作。

嗨@Jeeped，我知道这是一篇旧帖子，但我在从 URL 下载图片时遇到了同样的问题。我正在使用您的代码，但在 B 列中始终出现错误“-2146697208。我也使用了您的示例 URL，但它也会导致相同的错误。可能出了什么问题？