什麼是自動從Excel/VBA中的鏈接下載圖片的方法？

Question

所以情況就是這樣：我試圖從外部服務器下載一些圖片到我的本地計算機上。

Excel文件有一個鏈接，這將打開並下載畫中畫。

我到目前爲止已經試過是超鏈接轉換成只是文本（圖片URL）和運行下面的代碼。

我只有基本熟悉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 

列名是無關緊要的，但現在，一切都出來爲「無法下載文件」，或者如果它是成功的，它是不是在我的目錄指定。

有沒有更好的方法來編碼？

有關我的數據可能嗎？

我也想它如果可能的文件名中的另一列保存爲文本，但是這是沒有必要的。

現在我只需要他們下載。

Answer 1

試試這個：

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