Получение исходного кода HTML с помощью Excel-VBA

Question

Я хотел бы направить форму Excel VBA на определенные URL-адреса, получить исходный код HTML и сохранить этот ресурс в виде строки. Возможно ли это, и если да, то как мне это сделать?

Answer 1

Да. Один из способов сделать это - использовать MSXML DLL - и для этого вам необходимо добавить ссылку на библиотеку Microsoft XML через Инструменты-> Ссылки .

Вот некоторый код, который отображает содержимое данного URL:

Public Sub ShowHTML(ByVal strURL)
    On Error GoTo ErrorHandler
    Dim strError As String
    strError = ""
    Dim oXMLHTTP As MSXML2.XMLHTTP
    Set oXMLHTTP = New MSXML2.XMLHTTP
    Dim strResponse As String
    strResponse = ""

    With oXMLHTTP
        .Open "GET", strURL, False
        .send ""
        If .Status <> 200 Then
            strError = .statusText
            GoTo CleanUpAndExit
        Else
            If .getResponseHeader("Content-type") <> "text/html" Then
                strError = "Not an HTML file"
                GoTo CleanUpAndExit
            Else
                strResponse = .responseText
            End If
        End If
    End With

CleanUpAndExit:
    On Error Resume Next ' Avoid recursive call to error handler
    ' Clean up code goes here
    Set oXMLHTTP = Nothing
    If Len(strError) > 0 Then ' Report any error
        MsgBox strError
    Else
        MsgBox strResponse
    End If
    Exit Sub
ErrorHandler:
    strError = Err.Description
    Resume CleanUpAndExit
End Sub

Answer 2

Просто дополнение к ответу выше. Вопрос заключался в том, как получить исходный код HTML, который на самом деле не дает указанный ответ.

Сравните содержимое oXMLHTTP.responseText с исходным кодом в браузере для URL "http://finance.yahoo.com/q/op?s=T+Options". Они не совпадают, и даже возвращаемые значения отличаются. (Это следует выполнить через несколько часов, чтобы избежать изменений в течение торгового дня. )

Если я найду способ выполнить эту задачу, будет опубликован основной код.

Answer 3

Компакт getHTTP функция

Ниже представлена ​​компактная и универсальная функция, которая будет возвращать HTTP-ответ с указанного URL, например:

• возвращает HTML Источник веб-страницы,
• JSON ответ от URL API,
• парсинг текстового файла по URL и т. Д.

Это не требует каких-либо ссылок VBA, поскольку MSXML2 используется как объект с поздней привязкой.

Public Function getHTTP(ByVal url As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False: .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
End Function

Обратите внимание, что эта базовая функция не имеет проверки или обработки ошибок, поскольку это те части, которые могут значительно различаться в зависимости от того, какой URL вы нажимаете.

При желании проверьте значение .Status после .Send), чтобы проверить коды успеха, такие как 0 или 200, а также вы можете настроить ловушку ошибок с помощью On Error Goto... (никогда Resume Next!)

---

Пример использования:

Эта процедура очищает эту страницу переполнения стека для текущей оценки этого вопроса.

Sub demo_getVoteCount()
    Const answerID$ = 2522760
    Const url_SO = "https://stackoverflow.com/a/" & answerID
    Dim html As String, startPos As Long, voteCount As Variant

    html = getHTTP(url_SO)                                  'get html from url

    startPos = InStr(html, "answerid=""" & answerID)        'locate this answer
    startPos = InStr(startPos, html, "vote-count-post")     'locate vote count
    startPos = InStr(startPos, html, ">") + 1               'locate value

    voteCount=Mid(html,startPos,InStr(startPos,html,"<")-startPos) 'extract score
    MsgBox "Answer #" & answerID & " has a score of " & voteCount & "."
End Sub

_{Конечно, в действительности есть гораздо лучшие способы получить оценку ответа, чем в примере выше, например, этот способ.)}