什么是从Excel / VBA中的链接自动下载图片的方法?

时间:2014-03-05 00:04:46

标签: excel vba excel-vba hyperlink download

所以情况就是这样:我正在尝试将外部服务器上的一些图片下载到我的本地计算机上。

Excel文件有一个指向图片的链接,该图片将打开并下载图片。

到目前为止,我尝试将超链接转换为文本(图片网址)并运行以下代码。

我基本上只熟悉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:\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

列名无关紧要,但是现在,所有内容都显示为“无法下载文件”,或者如果成功,则不在我指定的目录中。

有更好的方法来编码吗?

关于我的数据可能有些什么?

如果可能的话,我也希望将文件名保存为另一列中的文本,但这不是必需的。

现在我只需要下载它们。

1 个答案:

答案 0 :(得分:2)

试试这个:

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