VBA：如何将MSXML2.XMLHTTP60响应连接到IHTMLDocument（iframe）

Question

我正在尝试使用MSXML2和IHTMLDocument 处理HTML网页的iframe部分。

我想使用MSXML2并将其保存以更好地“捕获”数据，认为它比仅使用VBA菜单支持的InternetExplorer或VBA硒参考要快。 （我不想尽可能避免使用IE或硒）

但是我无法找到如何将文档另存为XML格式（以利用其速度），并且同时在没有浏览器（即硒）的帮助下单击文档中的元素。 而且即使单击this web page上的某些标签（id =“ cns_Tab21”），我也很难检索数据。
所以我的问题是.. 1>是否可以最大程度地减少使用浏览器的点击次数？

2>即使单击（使用Selenium）后，它也会在VBA编辑器中引发与xpath相关的错误。

预先感谢您的回答，为此使用的网址是 http://bitly.kr/finance 并且链接内的iframe为http://bitly.kr/LT0aCb

    'I declared objects
    Dim XMLReq As New MSXML2.XMLHTTP60
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim iframeDoc As IHTMLDocument

    'and saved XML data to HTML format
     HTMLDoc.body.innerHTML = XMLReq.responseText

    'and trying to save this HTML to iframe...
    Set iframeDoc = HTMLDoc.getElementById("coinfo_cp")
    'I tried .contentDocument but it maybe HTMLdoc doesn't have this property. 

     and I don't know how to access information I saved to iframeDoc above. 



      'And after I use Selenium I can't figure out why it throw an error
       For Each ele In selenium.FindElementsByTag("th")
        If ele.Attribute("innerText") = "CAPEX" Then
        Debug.Print ele.FindElementsByXPath("./../td").Attribute("innerText")

由于我试图使用XML处理iframe元素并且在VBA Excel中没有InternetExplorer引用，因此这篇文章不是重复的。（p.document）

Answer 1

当选择该标签（而非iframe）时，您可以复制该页面发出的xhr请求。我使用剪贴板将表格复制到Excel。注意：我使用的网址来自我们的讨论。此信息应反映在问题中。

Option Explicit
Public Sub GetTable()
'VBE > Tools > References > Microsoft HTML Object Library
    Dim html As HTMLDocument, hTable As HTMLTable, clipboard As Object
    Set html = New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://navercomp.wisereport.co.kr/v2/company/ajax/cF1001.aspx?cmp_cd=005930&fin_typ=0&freq_typ=Y&encparam=ZXR1cWFjeGJnS1lWOHhCYmNScmJXUT09&id=bG05RlB6cn", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        html.body.innerHTML = .responseText
    End With

    Set hTable = html.querySelector(".hbG05RlB6cn + .gHead01")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' New DataObject
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
End Sub

---

您可以在页面的脚本中找到用于标签内容更新的ajax url的参数

连同更新目标：

---

这需要整理：

Option Explicit
Public Sub GetTable()
'https://navercomp.wisereport.co.kr/v2/company/c1010001.aspx?cmp_cd=005930
'VBE > Tools > References > Microsoft HTML Object Library
    Dim html As HTMLDocument, hTable As HTMLTable, clipboard As Object, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://navercomp.wisereport.co.kr/v2/company/ajax/cF1001.aspx?cmp_cd=005930&fin_typ=0&freq_typ=Y&encparam=ZXR1cWFjeGJnS1lWOHhCYmNScmJXUT09&id=bG05RlB6cn", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        html.body.innerHTML = .responseText

    End With

    Set hTable = html.querySelector(".hbG05RlB6cn + .gHead01") '2nd tab. CAPEX row

    Dim html2 As HTMLDocument, i As Long

    Set html2 = New HTMLDocument
    html2.body.innerHTML = hTable.outerHTML

    Dim tableBodyRows As Object, tableBodyRowLength As Long, tableHeaderRowLength As Long, tableHeaderRows As Object, targetRow As Long

    Set tableBodyRows = html2.querySelectorAll("tbody tr .bg")
    tableBodyRowLength = tableBodyRows.Length
    tableHeaderRowLength = html2.querySelectorAll("thead tr").Length + 2

    For i = 0 To tableBodyRowLength - 1
        If Trim$(tableBodyRows.item(i).innerText) = "CAPEX" Then
            targetRow = i + tableHeaderRowLength + 1
            Exit For
        End If
    Next

    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' New DataObject
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ws.Cells(1, 1).PasteSpecial

    Dim unionRng As Range

    For i = (tableHeaderRowLength + 1) To (tableBodyRowLength + tableHeaderRowLength)
        If i <> targetRow Then
            If Not unionRng Is Nothing Then
                Set unionRng = Union(ws.rows(i), unionRng)
            Else
                Set unionRng = ws.rows(i)
            End If
        End If
    Next
    If Not unionRng Is Nothing Then unionRng.Delete
End Sub