Question

我正在尝试在Excel单元格中的id下提取数据提取内部文本。

这是XML代码。

Sub getelementbyid()
Dim XMLpage As New MSXML2.XMLHTTP60
Dim hdoc As New MSHTML.HTMLDocument
Dim HBEs As MSHTML.IHTMLElementCollection
Dim HBE As MSHTML.IHTMLElement
Dim ha As String
XMLpage.Open "GET","https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=HAL", False
XMLpage.send
hdoc.body.innerHTML = XMLpage.responseText
ha = hdoc.getelementbyid("open").innerText
Range("K11").Value = ha
Debug.Print ha
End Sub

我期望输出值，但是它显示-。

Answer 1

检查响应文本。在浏览器中呈现页面的方式与在ResponseText中返回的方式有所不同。

我将URL放入浏览器，进入开发工具（F12），找到该元素，并记下HTML元素内的数字值。

然后，我将我们在VBA中获得的响应文本转储到一个单元格中，并将整个单元格值复制到Notepad ++中。如果这样做，您会看到#open元素内的初始值确实是“-”。

真正的价值似乎是通过JavaScript写入HTML的，这是常见的做法。页面顶部有一个JSON对象，可能是应您的请求从网站后端注入到文档中。

因此，您必须解析JSON，而不是HTML。我已经提供了执行此操作的代码。现在，也许有更好的方法了，我觉得这段代码有点“ hacky”，但是可以完成示例URL的工作。

Sub getelementbyid()
    Dim XMLpage As New MSXML2.XMLHTTP60
    Dim hdoc As New MSHTML.HTMLDocument

    Dim HBEs As MSHTML.IHTMLElementCollection
    Dim HBE As MSHTML.IHTMLElement
    Dim ha As String
    XMLpage.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=HAL", False
    XMLpage.send

    '// sample: ,"open":"681.05",
    Dim token As String
    token = """open"":"""

    Dim startPosition As Integer
    startPosition = InStr(1, XMLpage.responseText, token)

    Dim endPosition As Integer
    endPosition = InStr(startPosition, XMLpage.responseText, ",")

    Dim prop As String
    prop = Mid(XMLpage.responseText, startPosition, endPosition - startPosition)
    prop = Replace(prop, """", vbNullString)
    prop = Replace(prop, "open:", vbNullString)

    Dim val As Double
    val = CDbl(prop)
    ha = val

    Range("K11").Value = ha
    Debug.Print ha
End Sub

Answer 2

这是两种方法。 1）在返回文本上使用正则表达式。通常皱眉，但在这里可以很好地使用。 2）传统提取json字符串并使用json解析器解析出值。

您想要的数据存储在网页和xmlhtttp响应中位于同一元素下的json字符串中：

这意味着您可以将html视为字符串，并使用正则表达式将其定位为仅以开盘价为目标，如下所示，或者将xmlhttp请求解析为html解析器，获取所需的元素，提取其innerText并修剪掉空白，然后传递给json解析器以提取开盘价。

在两种方法中，您都希望避免向其提供缓存的结果，因此以下标头是尝试缓解此问题的重要补充：

.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"

不需要其他单元格格式。两种股票的全部价值都体现出来了。

正则表达式：

它存在于响应的json字符串中。您可以轻松地从返回文本中对它进行正则表达式处理。

正则表达式说明：

VBA：

Option Explicit
Public Sub GetClosePrice()
    Dim ws As Worksheet, re As Object, p As String, r As String

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    p = """open"":""(.*?)"""
    Set re = CreateObject("VBScript.RegExp")

    With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=HAL", False
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send
            If .Status = 200 Then
                r = GetValue(re, .responseText, p)
            Else
                r = "Failed connection"
            End If
    End With
    ws.Range("K11").Value = r
End Sub

Public Function GetValue(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .pattern = pattern
        If .test(inputString) Then  ' returns True if the regex pattern can be matched agaist the provided string
            GetValue = .Execute(inputString)(0).submatches(0)
        Else
            GetValue = "Not found"
        End If
    End With
End Function

HTML和json解析器：

这需要在名为JsonConverter的标准模块中从jsonconverter.bas安装jsonparser的代码，然后转到VBE>工具>参考>添加对Microsoft脚本运行时和Microsoft HTML对象库的引用。

VBA：

Option Explicit

Public Sub GetClosePrice()
    Dim ws As Worksheet, re As Object, r As String, json As Object

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuote.jsp?symbol=MRF", False
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
            .send
            If .Status = 200 Then
                Dim html As HTMLDocument
                Set html = New HTMLDocument
                html.body.innerHTML = .responseText
                Set json = JsonConverter.ParseJson(Trim$(html.querySelector("#responseDiv").innerText))
                r = json("data")(1)("open")
            Else
                r = "Failed connection"
            End If
    End With
    ws.Range("K11").Value = r
End Sub

如何在id下获取html的内部文本？

2 个答案:

正则表达式：

HTML和json解析器：