Private Sub btnRIC_Click()
    Dim strURL As String
    
    Dim IE As Object
    Dim hDoc As MSHTML.HTMLDocument
    Dim hCol As MSHTML.IHTMLElementCollection
    Dim hCell As MSHTML.IHTMLTableCell
    Dim hRow As MSHTML.IHTMLTableRow
    
    Dim HTTP As MSXML2.XMLHTTP
    
    Dim RS As ADODB.Recordset
    
    Dim i As Integer
    Dim sFileName
    Dim dFileDate As Date
    Dim sUrl As String
    
    Dim iFreeFile As Integer
    Dim vFileName As Variant
    Dim bFileDate() As Byte
    Dim sFolderName As String

On Error GoTo ErrHandler


    strURL = "https://sub.site.ru/download/All"
    sFolderName = "C:\11"

    'Создаём элемент эксплорера
    Set IE = CreateObject("InternetExplorer.Application")
    'Переходим по адресу
    IE.navigate strURL
    Do While IE.Busy Or IE.ReadyState <> 4 'READYSTATE_COMPLETE
        DoEvents
    Loop

    'Грузим документ
    Set hDoc = New MSHTML.HTMLDocument
    Set hDoc = IE.Document
    Do While Not hDoc.ReadyState = "complete"
        DoEvents
    Loop
    
'    Dim SSS As String
'    SSS = hDoc.body.innerHTML
'    udfClipBoardSetData (SSS)

    'Грузим коллекцию однотипных элементов (getElementsBy...)
    Set hCol = hDoc.getElementsByClassName("NewPackage")
    For i = 0 To hCol.Length - 1
        Set hRow = hCol.Item(i)
        dFileDate = hRow.cells(0).innerText
        sFileName = hRow.cells(2).innerText
        sUrl = hRow.cells(2).all.Item(1)
        
        Set HTTP = New MSXML2.XMLHTTP
        HTTP.Open "GET", sUrl, False
        HTTP.send
        
        sFileName = sFolderName & "\" & sFileName
        'Проверяем, не существует ли уже этот файл?
        If Len(Dir(sFileName)) > 0 Then
            Kill sFileName
            If Len(Dir(sFileName)) > 0 Then
                MsgBox "Не удалось сохранить файл!", vbExclamation, "Ошибка открытия"
                GoTo ExitHere
            End If
        End If
        'Записываем данные
        iFreeFile = FreeFile
        Open sFileName For Binary Access Write As iFreeFile
        'Переписываем данные в массив - ибо из рекордсета он тянуть на прямую желает, но желает это коряво
        ReDim bFileDate(0 To LenB(HTTP.responseBody) - 1)
        bFileDate = HTTP.responseBody
        'Заливаем в файл
        Put iFreeFile, , bFileDate
        Close iFreeFile
        
    Next i

ExitHere:
    Set IE = Nothing
    Set hDoc = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Source & "-->" & Err.Number & ":" & Err.Description, vbExclamation, "Error"
    Resume ExitHere
    Resume
End Sub