Question

我在A2中有一个带有名字的文字。在b2，c2，d2，e2，f2我有图片链接。我想下载所有链接，并将其重命名为A2，但添加到文件名_01，_02，_03，_04，_05，具体取决于图片是否来自b2，c2等。

我为更好地解释它做了一张照片。 http://oi57.tinypic.com/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

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

1 个答案: