使用Excel-VBA获取HTML源代码

Question

我想将excel VBA表单定向到某些URL，获取HTML源代码并将该资源存储在字符串中。这是可能的，如果是这样，我该怎么做？

Answer 1

是。一种方法是使用MSXML DLL - 为此，您需要通过工具 - >参考添加对Microsoft XML库的引用。

以下是一些显示给定网址内容的代码：

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函数

以下是紧凑的通用函数，它将从指定的URL返回HTTP响应，例如：

• 返回网页的HTML来源，
• JSON来自API URL的响应
• 通过URL解析文本文件，等等。

因为MSXML2被用作后期绑定对象，所以不需要不需要任何VBA引用。

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而有很大差异。

如果需要，请检查.Send之后的.Status的值以检查诸如0或200之类的成功代码，还可以使用以下命令设置错误陷阱： On Error Goto... （永远不会Resume Next！）

---

用法示例：

此过程将为 this 问题的当前分数刮除 this 堆栈溢出页面。

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

_{当然，实际上，与上面的示例相比，获得答案分数的方法要好得多，例如this。）}