Download data from hyperlinks into creating new folders using vba - vba

Question

Image of data in excelI am downloading some data from net using hyperlinks and to put downloaded data into folders created with names listed in A column.
Right now data is successfully downloaded when there is only one hyperlink for one folder, but now I also wants to put more than 2 files data into same folder.
Can anyone suggest a way to enhance the code to allow that?
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

edited after OP clarifications he doesn't have hyperlinks
as per your shown code and link, your code doesn't actually create new folders, rather it creates many new files in "C:\Users\a3rgcw\Downloads\" folder (i.e. your FolderName variable
and since those files names are built with ws.Range("A" & i).Value & ".zip", then for every same value in any column A cell it overwrites the existing file with the new one
furthermore your link shows column "C" with hyperlinks while your code read them from column "D" (ws.Range("D" & i).Value
to avoid files overwriting you could define zip name out of a combination of "folder" name (from column A cells) and file name (from corresponding hyperlink address) like follows (assuming your code assumption for hyperlinks column is the valid one)
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
which could also be refactored as follows:
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