With Excel vba, save web image to disk - image

Question

I am trying to save an image from a webpage using excel vba.
I'm managed to get the string (although not the one I want), and need to save it to disk.
The HTML code for the source is:
<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="{"0to1024":"/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA","1025to1450":"//www.staples.no/content/images/product/491215_1"}" data-screensize="">
My code is: IMG = .document.getElementById("SkuPageMainImg").src
This code captures the url after the src= :
/content/images/product/491215_1_xnm.jpg?v=4TWLBni1V4k8GV8B_0P-GA"
This will do, but what i would preffer to catch is the url after data-zoomimage= :
"//www.staples.no/content/images/product/491215_1_xnl.jpg"
Either way, what I am looking to accomplish is having Excel VBA save the image to a file on my disk - typically c:\folder\image_name.jpg
Anybody know the code to do this?

Answer 1

Import the URLDownloadToFile function and use it directly. The following is an entire module code sheet, including the declarations section at the top. The routine expects a list of the full img src URLs in column A starting at row 2. e.g.: 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
A value of 0 is column B indicates success (e.g. ERROR_SUCCESS).