What is a way to automate downloading a picture from a link in Excel/VBA?

问题

So here's the situation: I'm trying to download a number of pictures from an external server onto my local computer.

The Excel file has a link to the picture which will open and download the picture.

What I've tried so far is to convert the hyperlinks into just text (of the picture url) and run the following code.

I'm only basically familiar with VBA, more so with other languages though. Here is the code I have so far:

  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:\Users\My Name\Downloads\"

  Sub DownloadLinks()
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("B" & Rows.Count).End(xlUp).Row

  For i = 2 To LastRow '<~~ 2 because row 1 has headers
    strPath = FolderName & ws.Range("BP" & i).Value & ".jpg"

    Ret = URLDownloadToFile(0, ws.Range("BP" & i).Value, strPath, 0, 0)

    If Ret = 0 Then
        ws.Range("CA" & i).Value = "File successfully downloaded"
    Else
        ws.Range("CA" & i).Value = "Unable to download the file"
    End If
Next i

  End Sub

The column names are irrelevant, but right now, everything comes out as "Unable to download file" or if it is successful, it isn't in the directory I specified.

Is there a better way to code this?

Something about my data maybe?

I'd also like it to save the file name as text in another column if possible, but that isn't necessary.

Right now I just need them to get downloaded.

回答1:

Try this:

Sub DownloadLinks()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String, strURL As String
Dim c As Range


    Set ws = Sheets("Sheet1")

    LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow

        Set c = ws.Range("BP" & i)
        If c.Hyperlinks.Count>0 Then
            strPath = FolderName & c.Value & ".jpg"
            strURL = c.Hyperlinks(1).Address

            Ret = URLDownloadToFile(0, strURL, strPath, 0, 0)

            ws.Range("CA" & i).Value = IIf(Ret = 0, _
                                    "File successfully downloaded", _
                                    "Unable to download the file")
        Else
            ws.Range("CA" & i).Value = "No hyperlink!"
        End If
    Next i

End Sub

来源：https://stackoverflow.com/questions/22185853/what-is-a-way-to-automate-downloading-a-picture-from-a-link-in-excel-vba