Webscraping на вложениях

Question

Здравствуйте. Я пытаюсь загрузить файлы с сайта и сохранить все файлы в указанной папке c.

Ниже приведены шаги, которые мне нужны.

1. Переходите по сайтам / ссылкам, указанным в столбце A, один за другим
2. Скачивайте все файлы, относящиеся к каждому сайту / ссылке, по указанному пути столбца B.
3. Там могут быть вложения 1 или 2 или более 10 et c. или иногда там может не быть вложений. (К вашему сведению)

Я подготовил код для этого, но он вытягивает только имена файлов, но не содержимое ..., которое не удалось. Я все еще пытаюсь найти результат ...

Sub AP()
Dim IE As New InternetExplorer, html As HTMLDocument
Dim elem As Object, data As String
With IE
    .Visible = True
    .navigate "https://www.MyURL.com"
    Do While .readyState <> READYSTATE_COMPLETE: Loop
    Set html = .document
End With
data = ""
For Each elem In html.getElementsByClassName("pull-right")(0) _
.getElementsByTagName("a")
    data = data & " " & elem.innerText
Next elem
Range("A1").Value = data

IE.Quit

End Sub

Любая помощь .. Спасибо

Answer 1

Можете ли вы попробовать это и отзывы?

Sub TryMe()
    Dim i As Long
    Dim FileNum As Long
    Dim FileData() As Byte
    Dim MyFile As String
    Dim WHTTP As Object
    Dim lrow As Long
    Dim ws As Excel.Worksheet

    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("C:\MyDownloads", vbDirectory) = Empty Then MkDir "C:\MyDownloads"

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ws
        For lrow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            MyFile = Cells(lrow, 1).Text
            TempFile = Right(MyFile, InStr(1, StrReverse(MyFile), "/") - 1)
            WHTTP.Open "GET", MyFile, False
            WHTTP.Send
            FileData = WHTTP.ResponseBody

            FileNum = FreeFile
            Open "C:\MyDownloads\" & TempFile For Binary Access Write As #FileNum
                Put #FileNum, 1, FileData
            Close #FileNum
            DoEvents
        Next lrow
    End With

    Set WHTTP = Nothing
    MsgBox "Open the folder [ C:\MyDownloads ] for the downloaded file..."
End Sub