vba 从url下载图片并保存在以单元格命名的文件夹中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23742636/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Download pictures from url and save in a folder named by a cell
提问by Jacek Michalski
I have a worksheet with folder names, image names and urls. I want to download each image to the specific folder so that the outcome would look like this:
我有一个包含文件夹名称、图像名称和 url 的工作表。我想将每个图像下载到特定文件夹，以便结果如下所示：
Folder Name Image Name URL
----------- ------------ -----------------------------------
folder1 image1 http://www.example.com/example1.jpg
folder2 image2 http://www.example.com/example2.jpg
folder3 image3 http://www.example.com/example3.jpg
folder4 image4 http://www.example.com/example4.jpg
folder5 image5 http://www.example.com/example5.jpg
C:\images\folder1\image1.jpg
C:\images\folder2\image2.jpg
C:\images\folder3\image3.jpg
C:\images\folder4\image4.jpg
C:\images\folder5\image5.jpg
I've found this VBA code and it works like a charm, but I don't know how to add a method to creat folders if they don't exist:
我找到了这个 VBA 代码，它就像一个魅力，但我不知道如何添加一个方法来创建文件夹，如果它们不存在：
Option Explicit
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
Dim Ret As Long
'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Temp\"
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
'~~> Name of the sheet which has the list
Set ws = Sheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow '<~~ 2 because row 1 has headers
strPath = FolderName & ws.Range("A" & i).Value & ".jpg"
Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)
If Ret = 0 Then
ws.Range("C" & i).Value = "File successfully downloaded"
Else
ws.Range("C" & i).Value = "Unable to download the file"
End If
Next i
End Sub
采纳答案by Jimmy Smith
回答by bmwjohnno
I found some errors in the original VBS Code. Here is an update.
我在原始 VBS 代码中发现了一些错误。这是一个更新。
For i = 2 To LastRow '<~~ 2 because row 1 has headers
strPath = FolderName & ws.Range("A" & i) ***& "\" & ws.Range("B" & i)***.Value & ".jpg"
If Len(Dir(FolderName & ws.Range("A" & i) & "\", vbDirectory)) = 0 Then
MkDir FolderName
End If
Ret = URLDownloadToFile(0, ***ws.Range("C" & i)***.Value, strPath, 0, 0)
- The folder is actually in Column B and needs to be added to the path
- The URL is actually in Column C
- 该文件夹实际上在B列中，需要添加到路径中
- URL 实际上在 C 列中
