Скачать картинку через xmlhttp

Question

Я пытаюсь получить атрибут sr c изображений на странице, а затем загрузить это изображение и вот мой код

picURL = "https://iofferman.x.yupoo.com/33269655?uid=1"

Set htmlPic = GetHTML(picURL)
Debug.Print Replace(htmlPic.querySelector(".viewer__imgwrap img").getAttribute("src"), "about:", "https:")
Dim myPic As String
myPic = Replace(htmlPic.querySelector(".viewer__imgwrap img").getAttribute("src"), "about:", "https:")
'URLDownloadToFile 0, myPic, ThisWorkbook.Path & "\" & picID & ".jpg", 0, 0
Call SaveWebFile(myPic, ThisWorkbook.Path & "\" & picID & ".jpg")

Это связано с кодом

Function GetHTML(ByVal sURL As String) As HTMLDocument
    Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
    Set http = New MSXML2.XMLHTTP60
    Set html = New MSHTML.HTMLDocument
    With http
        .Open "Get", sURL, False
        .send
        html.body.innerHTML = .responseText
    End With
    Set GetHTML = html
End Function

и это UDF для загрузки изображения

Function SaveWebFile(ByVal sFile$, ByVal sPath$) As Boolean
    Dim f&, oResp() As Byte
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", sFile, False
        .send
        Do While (.readyState <> 4): DoEvents: Loop
        oResp = .responseBody
    End With
    f = FreeFile
    If Dir(sPath) <> "" Then Kill sPath
    Open sPath For Binary As #f
    Put #f, , oResp
    Close #f
End Function

Я мог бы получить ссылку на изображение, например: https://photo.yupoo.com/iofferman/2d03c9b8/326e8e47.jpg, но при переходе к нему я иногда мог получить изображение правильно, а иногда дает мне такой некорректный вывод http://adc.yupoo.com/res/703.gif. Как правильно скачать картинку?

Answer 1

Вы можете скачать изображения через ADODB.Stream:

Sub DownloadFile(ImageURL, SavePath)

    Dim WinHttpReq As Object

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", ImageURL, False
    WinHttpReq.send
    
    If WinHttpReq.Status = 200 Then
        Set MyStream = CreateObject("ADODB.Stream")
        MyStream.Open
        MyStream.Type = 1
        MyStream.Write WinHttpReq.responseBody
        MyStream.SaveToFile SavePath, 2 ' 1: Don't overwrite, 2: Overwrite
        MyStream.Close
    End If

End Sub