Mass Hypelink Download

[Minititan]

I have a list of 2000 hyperlinks (http) that I need to download, I'm working on a corporate network so I can't just use a mass download client. Cany anyone give me some guidance creating a macro to save the target of the hyperlink as a file then move on to the next hyperlink until the list is exhausted.

Is this possible?

 

[Minititan]

Thanks for the reply

I don't really want to use a "hack" like that, the only reason I mentioned it was because I thought the other ay was not possible.

 

[Legacy 98055]

Try this...

I am not sure what header to set...

Option Explicit

Private Const Folder As String = "C:\Users\Tom\Desktop\Temp"

'assumes that your URLs are in A1:A? of this worksheet
Sub Example()
    Dim r As Range
    Dim ResolvedToLocal As String
    Dim Request As Object
    
    On Error Resume Next
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
    If Request Is Nothing Then
        Set Request = CreateObject("WinHttp.WinHttpRequest.5")
    End If
    On Error GoTo 0
    
    If Request Is Nothing Then
        'WinHttp not installed
        Exit Sub
    End If
    
    Set r = [a1]
    
    Do Until r = ""
        r.Offset(, 2) = DownloadFile(Request, CStr(r.Value), ResolvedToLocal)
        r.Offset(, 1) = ResolvedToLocal
        Set r = r.Offset(1)
    Loop
End Sub

Function DownloadFile(Request As Object, ByVal URL As String, Optional ByRef ResolvedToLocal As String) As Boolean
    Dim FileNum As Integer
    Dim FileName As String
    Dim Post
    Dim b() As Byte

    On Error GoTo Err_DownloadFile
    
    Post = Split(URL, "?")
    
    Request.Open "POST", Post(0) & "?", False
    Request.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
    Request.Send Post(1)

    FileName = Request.GetResponseHeader("Content-disposition")
    FileName = Mid(FileName, InStrRev(FileName, "=") + 1)
    FileName = Folder & "\" & Replace(FileName, """", "")
    ResolvedToLocal = FileName
    
    FileNum = FreeFile
    Open FileName For Binary As #FileNum
        b() = Request.ResponseBody
        Put #FileNum, 1, b()
    Close FileNum
    
    DownloadFile = (Request.StatusText = "OK")
     
Err_DownloadFile:
End Function