Download files from multiple links

[valseref]

Hello to all,

Could you pls help me to extract the files from the attached file sample via VBA code.

I would like the files to be extracted in a new folder on the desktop. /lets put the folder name as "new folder" for now.

Many many thanks in advance for your time,
Valentina

 

[Marc L]

Hello Valentina,​

​

according to your attachment a VBA demonstration for starters to paste to the top of the worksheet module​

(under Windows only, for Excel versions prior to 2010 version just remove PtrSafe statement …) :​

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath$) As Boolean

Sub Demo1()
    Dim P$, V, R&, S$(), H$, B() As Byte, F%
        P = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\new folder\"
        If MakeSureDirectoryPathExists(P) = False Then Beep: Exit Sub
        V = [A1].CurrentRegion.Value2
    With CreateObject("WinHttp.WinHttpRequest.5.1")
            Application.Cursor = 2
            On Error Resume Next
        For R = 2 To UBound(V)
                S = Split(V(R, 1), "?id="):  If UBound(S) = 0 Then S = Split(V(R, 1), "&id=")
            If UBound(S) = 1 Then
                    Application.StatusBar = "       Downloading  :  " & Split(S(1), "&")(0)
                    If R Mod 9 = 0 Then DoEvents
                    Err.Clear
                   .Open "GET", V(R, 1), False
                   .SetRequestHeader "DNT", "1"
                   .Send
                If Err.Number = 0 Then
                        H = .GetResponseHeader("Content-Disposition")
                    If Err.Number Then
                            S = Split(.ResponseText, "location.href=""")
                        If UBound(S) = 1 Then
                            V(R, 1) = Left(V(R, 1), InStrRev(V(R, 1), "/")) & Split(S(1), """")(0)
                            R = R - 1
                        End If
                    ElseIf H Like "inline; filename=""*""*" Then
                        B = .ResponseBody
                        F = FreeFile(1)
                        Open P & Split(H, """")(1) For Binary As #F
                        Put #F, , B
                        Close #F
                    End If
                End If
            End If
        Next
    End With
        Application.StatusBar = False
        Application.Cursor = xlDefault
        ThisWorkbook.FollowHyperlink P
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[valseref]

Dear Marc L, this is just fantastic.

Thank you very very much for the help.

Whishing you all the best