Massive Download from links - Save as

[paulobitt]

Hello guys,

I found a code that download all archives from links located in the Column Q, and it's working very well. But would be perfect if I could download with a diferent filename, using the value of column S. Thank you in advance for the help!


Sub imagestore()

Dim i As Long
Dim lastRow As Long
Dim beginningRow As Long
Dim FileNum As Long
Dim columnNum As Long
Dim FileData() As Byte
Dim filesLocation As String
Dim MyFile As String
Dim message As String
Dim WHTTP As Object

beginningRow = 55
lastRow = WorksheetFunction.CountA(Columns(17)) + beginningRow - 2

filesLocation = "C:\Users\<username>\</username>Desktop\<foldername></foldername>" 'Specifies where to put file
columnNum = 17 'Specifies column number to pull from

On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0

If Dir(filesLocation, vbDirectory) = Empty Then MkDir filesLocation

For i = beginningRow To lastRow 'Sets range from row variables
MyFile = Cells(i, columnNum).Text
TempFile = Right(MyFile, InStr(1, StrReverse(MyFile), "/") - 1)
WHTTP.Open "GET", MyFile, False
WHTTP.Send
FileData = WHTTP.ResponseBody

FileNum = FreeFile
Open filesLocation & TempFile For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
Next
Set WHTTP = Nothing


message = "Files downloaded to " & filesLocation

MsgBox message 'Alerts user to location of download

End Sub