從超鏈接下載數據到使用vba創建新文件夾

Question

Image of data in excel我使用超鏈接從網上下載一些數據，並將下載的數據放入使用A列中列出名稱創建的文件夾中。

現在當一個文件夾只有一個超鏈接時數據成功下載，但現在我也想將超過2個文件數據放入同一個文件夾。

任何人都可以提出一種方法來增強代碼，以允許？

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 files will be saved. Change as applicable 
Const FolderName As String = "C:\Users\a3rgcw\Downloads\" 

Sub Download() 

    Dim ws As Worksheet 
    Dim lastRow As Long, i As Long 
    Dim strPath As String 

    Set ws = Sheets("Sheet1") 

    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row 

    For i = 1 To lastRow 

     strPath = FolderName & ws.Range("A" & i).Value & ".zip" 
     ret = URLDownloadToFile(0, ws.Range("D" & i).Value, strPath, 0, 0) 

     If ret = 0 Then 
      ws.Range("F" & i).Value = "PR data successfully downloaded" 
     Else 
      ws.Range("F" & i).Value = "Unable to download PR data" 
     End If 

    Next i 

End Sub 

Answer 1

編輯 OP澄清後，他沒有超鏈接

按你的代碼所示和紐帶，你的代碼實際上並沒有創建新文件夾，而它會在「C許多新文件：\用戶\ a3rgcw \下載\」文件夾（即你的FolderName變量

，並因爲這些名稱與ws.Range("A" & i).Value & ".zip"建文件，然後在任何列它覆蓋用新的

現有文件中的單元格每一個相同的值

而且你的鏈接顯示的列「C」的超鏈接，而你的代碼列「d」讀他們（ws.Range("D" & i).Value

，以避免文件覆蓋，你可以出去的「文件夾」名稱的組合定義拉鍊名（從柱A細胞）和文件名（從相應的超鏈接地址）喜歡如下（假設爲超鏈接列代碼的假設是有效的）

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

    Set ws = Sheets("Sheet1") 

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).row 

    For i = 1 To LastRow 
     strPath = FolderName & _ 
        ws.Range("A" & i).Value & "-" & _ 
        GetName(ws.Range("D" & i)) & ".zip" 
     ret = URLDownloadToFile(0, ws.Range("D" & i).Value, strPath, 0, 0) 

     If ret = 0 Then 
      ws.Range("F" & i).Value = "PR data successfully downloaded" 
     Else 
      ws.Range("F" & i).Value = "Unable to download PR data" 
     End If  
    Next i 
End Sub 

Function GetName(rng As Range) As String 
    With rng 
     GetName = Right(.Value, Len(.Value) - InStrRev(.Value, "/")) 
    End With 
End Function 

這也可以被重構如下：

Sub Download() 
    Dim strPath As String 
    Dim cell As Range 

    With Sheets("Sheet1") 
     For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 
      strPath = FolderName & _ 
         cell.Value & "-" & _ 
         GetName(cell.Offset(, 3)) & ".zip" 
      ret = URLDownloadToFile(0, cell.Offset(, 3).Value, strPath, 0, 0) 
      cell.Offset(, 5).Value = IIf(ret = 0, "PR data successfully downloaded", "Unable to download PR data") 
     Next 
    End With 
End Sub 

Function GetName(rng As Range) As String 
    With rng 
     GetName = Right(.Value, Len(.Value) - InStrRev(.Value, "/")) 
    End With 
End Function