Загрузить данные из гиперссылок в создание новых папок с помощью vba

Question

Image of data in excel Я загружаю некоторые данные из сети с помощью гиперссылок и помещаю загруженные данные в папки, созданные с именами, перечисленными в столбце A.

В настоящее время данные успешно загружаются, когда имеется только одна гиперссылка для одной папки, но теперь я также хочу помещать более двух файлов в одну папку.

Может ли кто-нибудь предложить способ улучшить код, чтобы это можно было сделать?

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 : \ Users \ a3rgcw \ Downloads \»папка (т.е. вашего FolderName переменной

и с теми файлами имена построены с ws.Range("A" & i).Value & ".zip", то для каждого же значения в любой колонке клетки перезаписывает существующий файл с новым

Кроме того, ваша ссылка показывает столбец «C» с гиперссылками в то время как ваш код читать их из столбца «D» (ws.Range("D" & i).Value

избежать файлов перезаписи можно определить имя почтового индекса из комбинации имени «папки» (из колонки а клетка) и имя файла (с соответствующей гиперссылка адреса), например следующим образом (при условии, что ваш код допущение для столбца гиперссылка является допустимым)

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