使用Excel vba，将Web映像保存到磁盘 [英] With Excel vba, save web image to disk

问题描述

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

源代码的HTML代码是：

 < img id =SkuPageMainImgdata-sku =491215alt =Papir ubleket kraft 60g 40cm 5kg / rullclass =skuImageSTDsrc =/ content / images / product / 491215_1_xnm.jpg？v = 4TWLBni1V4k8GV8B_0P-GAdata-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; 1025to1450& ; // 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
  / pre> 
 
 
这样做，但是我会提前抓住的是 data-zoomimage = 之后的URL： 
 // www.staples.no/content/images/product/491215_1_xnl.jpg 
 
 
 
无论哪种方式，我想要完成的是将Excel VBA将图像保存到磁盘上的文件 - 通常 c：\folder\image_name.jpg  
 
 
 
任何人都知道这样做的代码？
解决方案
导入URLDownloadToFile函数并直接使用它，以下是一个完整的模块代码表，其中包括顶部的声明部分。该例程期望列表A中的完整的img src URL从r开始ow 2.例如： http://www.staples.no/content/images /product/491215_1_xnm.jpg  
 
 
 
  
  Option Explicit 
 
＃如果VBA7和Win64然后
私人声明PtrSafe函数URLDownloadToFile Liburlmon_ 
别名URLDownloadToFileA（_ 
 ByVal pCaller As LongPtr，_ 
 ByVal szURL As String，_ 
 ByVal szFileName As String，_ 
 ByVal dwReserved As LongPtr，_ 
 ByVal lpfnCB As LongPtr _ 
）As Long 
私有声明PtrSafe函数DeleteUrlCacheEntry LibWininet.dll_ 
别名DeleteUrlCacheEntryA（ _ 
 ByVal lpszUrlName As String _ 
）As Long 
 #Else 
私有声明函数URLDownloadToFile Liburlmon_ 
别名URLDo wnloadToFileA（_ 
 ByVal pCaller As Long，_ 
 ByVal szURL As String，_ 
 ByVal szFileName As String，_ 
 ByVal dwReserved As Long，_ 
 ByVal lpfnCB As Long _ 
）As Long 
私有声明函数DeleteUrlCacheEntry LibWininet.dll_ 
别名DeleteUrlCacheEntryA（_ 
 ByVal lpszUrlName As String _ 
）As Long 
 #End如果
 
 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
如果Dir（sIMGDIR，vbDirectory）=然后MkDir sIMGDIR 
 
使用ActiveSheet'& - 设置此工作表参考正确！ 
 lr = .Cells（Rows.Count，1）.End（xlUp）.Row 
对于rw = 2 To lr 
 
 sWAN = .Cells（rw，1）。 Value2 
 sLAN = sIMGDIR& Chr（92）&修剪（右（替换（sWAN，Chr（47），空格（999）），999））
 
 Debug.Print sWAN 
 Debug.Print sLAN 
 
如果CBool​​（Len（Dir（sLAN）））然后
调用DeleteUrlCacheEntry（sLAN）
 Kill sLAN 
如果
 
 ret = URLDownloadToFile（0& sWAN， sLAN，BINDF_GETNEWESTVERSION，0&）
 
 .Cells（rw，2）= ret 
下一个rw 
结束
 
 End Sub 
  
值为0是列B表示成功（例如ERROR_SUCCESS）。
 
 
 
  
 
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="{&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="">
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?
解决方案
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).

        

                        
这篇关于使用Excel vba，将Web映像保存到磁盘的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！