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

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

源代码的HTML代码是：

<img id="SkuPageMainImg" data-sku="491215" alt="Papir ubleket kraft 60g 40cm 5kg/rull" 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=是抓住的是后的url data-zoomimage= ： "//www.staples.no/content/images/product/491215_1_xnl.jpg" data-zoomimage= "//www.staples.no/content/images/product/491215_1_xnl.jpg"

无论哪种方式，我期望完成Excel VBA保存图像到我的磁盘上的文件 – 通常是c:\folder\image_name.jpg

有人知道这样做的代码？

Answer 1

导入URLDownloadToFile函数并直接使用它。 以下是整个模块代码表，其中包括顶部的声明部分。 该例程需要列A中从第2行开始的完整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）。