从超链接下载图片到特定文件夹

时间:2014-12-18 08:37:44

标签: vba excel-vba hyperlink excel

我有一个包含文件夹名称(col A),图片名称(col B)和超链接(col C)的excel文件我想将图片从超链接下载到特定文件夹(在col A中表示)。

FolderName ImageName网址

folder1 image1 hyperlink 1

folder2 image2 hyperlink 2

folder3 image3 hyperlink 3

我找到了这段代码:

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:\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("B" & i).Value & ".jpg"

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

    If Len(Dir(FolderName, vbDirectory)) = 0 Then
        MkDir FolderName
    End If

    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

它将文件下载到C:\ TMP \但我想将它连续下载到相应的文件夹(col A)

1 个答案:

答案 0 :(得分:0)

这很简单。

由于您使用CONSTANT作为保存目录Const FolderName As String = "c:\TEMP\",如果您将代码复制粘贴到工作簿中,则不会太远。

您应该首先尝试了解代码的工作原理并尝试一下,但无论如何......

如果不插入Const行,则必须Dim一个变量,该变量将包含您的目录字符串,并且每次更改行时都会更改。基本上在这里:

For i = 2 To LastRow

    FolderName = ws.Range("A" & i).text ' this is how you get the folder name from column "A" every line
    strPath = FolderName & ws.Range("B" & i).Value & ".jpg"

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

    If Len(Dir(FolderName, vbDirectory)) = 0 Then
        MkDir FolderName
    End If

    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