VBA-Excel图片下载到本地文件夹

操作步骤

1. 打开包含商品信息和图片url的excel
2. Alt+F11进入vba

   3. 复制VBA代码并修改对应的：

        1.图片保存路径，要求路径不存在或者要清空（清空是因为如果已存在对应图片则不会更新），一定要在路径末尾添加“\”。

        2. url所在列（建议使用默认形式，第一列为款号列，第二列为图片URL列）

        3. 图片宽和高也可修改，默认宽为500，长为550

        4. vba代码

Sub DownloadImages()Dim rng As Range, cell As RangeDim imgUrl As String, savePath As String, fileName As StringDim http As Object, stream As ObjectDim tempFilePath As StringDim img As ObjectDim FSO As Object Set http = CreateObject("MSXML2.XMLHTTP")Set stream = CreateObject("ADODB.Stream")Set img = CreateObject("WIA.ImageFile")Set FSO = CreateObject("Scripting.FileSystemObject")savePath = "C:\商品图片\" '修改为实际保存路径，路径末尾一定要加上\If Not FSO.FolderExists(savePath) Then FSO.CreateFolder(savePath) tempFilePath = Environ("Temp") & "\ExcelImages\"If Not FSO.FolderExists(tempFilePath) Then FSO.CreateFolder(tempFilePath)On Error Resume NextFor Each cell In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row) '图片URL所在列imgUrl = cell.ValuefileName = savePath & cell.Offset(0, -1).Value & ".jpg" '款号列为url列向左偏移一列Dim tempFile As StringtempFile = tempFilePath & "temp_" & cell.Offset(0, -1).Value & ".jpg"http.Open "GET", imgUrl, Falsehttp.SendIf http.Status = 200 Thenstream.Openstream.Type = 1stream.Write http.responseBodystream.SaveToFile tempFile, 2stream.CloseIf FSO.FileExists(fileName) ThenFSO.DeleteFile fileName, True End Ifimg.LoadFile tempFileDim ip As ObjectSet ip = CreateObject("WIA.ImageProcess")ip.Filters.Add ip.FilterInfos("Scale").FilterIDWith ip.Filters(1).Properties.Item("MaximumWidth") = 500 ' 设置最大宽度.Item("MaximumHeight") = 550 ' 设置最大高度.Item("PreserveAspectRatio") = FalseEnd WithDim processedImg As ObjectSet processedImg = ip.Apply(img)processedImg.SaveFile fileNameIf FSO.FileExists(tempFile) ThenFSO.DeleteFile tempFile, TrueEnd IfEnd IfNext cellIf FSO.FolderExists(tempFilePath) ThenFSO.DeleteFolder tempFilePath, TrueEnd IfMsgBox "图片下载完成！"
End Sub

1. 点击运行，完成状态显示如下：

对应文件位置会自动生成文件夹及图片（图片大小为url实际的图片大小）