Option Explicit

Sub downloadFile()

    Const FOLDER = "D:\SF\"
    
    Dim fso As Object, ws As Worksheet, wb As Workbook
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not (fso.FolderExists(FOLDER)) Then MkDir FOLDER

    Dim oWinHttp As Object, oStream
    Dim URL As String, FilePath As String
    Dim n As Long, r As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Tabelle1")
    Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
        
    r = 7
    FilePath = ws.Cells(r, "A")
    Do While Len(FilePath) > 0
    
        If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

        ' check folder exists
        If Not fso.FolderExists(FOLDER & FilePath) Then
             'Debug.Print FOLDER & FilePath
             MkDir FOLDER & FilePath
        End If

        URL = ws.Cells(r, "D").Value
        oWinHttp.Open "GET", URL, False
        oWinHttp.Send
        If oWinHttp.Status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            With oStream
                .Open
                .Type = 1
                .Write oWinHttp.ResponseBody
                .SaveToFile FOLDER & FilePath & "File " & r, 2 ' 1 = no overwrite, 2 = overwrite
                .Close
            End With
            n = n + 1
        Else
            MsgBox URL, vbExclamation, "Status " & oWinHttp.Status
        End If

        r = r + 1
        FilePath = ws.Cells(r, "A")
       
    Loop
    MsgBox n & " files created", vbInformation
   
End Sub