Excel从超链接下载图片

时间:2015-08-05 16:23:49

标签: excel vba excel-vba

我目前正在使用此代码使用开发者控制台尝试从我在Excel文档中的超链接中大量下载所有图像。

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:\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("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

如果我在A栏中的图片名称列是这样的话,它会下载图像 - “calculator.jpg”

但是,我希望图片名称是我用来下载图片的超链接,例如www.hyperlink.com/calculator.jpg

当超链接位于图片名称列中时,我的代码似乎无法下载图像,即使它在C列中打印“下载成功”。

如果有人可以帮助我,我会非常感激!

1 个答案:

答案 0 :(得分:0)

  

但是,我希望图片名称是我用来下载图片的超链接,例如www.hyperlink.com/calculator.jpg

就像我在上面的评论中所说的那样,&#34;你不能将图片名称作为超链接作为&#34; /&#34;不是文件名的有效字符。你必须提取&#34; calculator.jpg&#34;从col A开始,然后在代码&#34;

中使用它

这是你在尝试的吗?

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 = "D:\Temp\"

Sub Sample()
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath As String
    Dim MyAr

    '~~> 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
        MyAr = Split(ws.Range("A" & i).Value, "/")

        '~~> C:\Temp\Calculator.jpg
        strPath = FolderName & MyAr(UBound(MyAr))

        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