excel - VBA : how to connect MSXML2. XMLHTTP60 对 IHTMLDocument(iframe) 的响应

Question

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

我想使用 MSXML2 并将其保存以更好地“捕获”数据，认为它比仅使用 InternetExplorer 或 VBA 菜单支持的 VBA Selenium 引用更快。
(我不想尽可能避免使用 IE 或 selenium)

但是我不知道如何将文档保存为 XML 格式(以利用其速度)，同时在没有浏览器(即 Selenium )帮助的情况下单击文档中的元素。
甚至在单击 this web page 上的某些选项卡(id="cns_Tab21") 之后，我很难检索数据。
所以我的问题是..
1> 是否可以尽量减少使用浏览器进行点击？

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

感谢您提前回答，用于此的 URL 是
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 引用。(ie.document)

Answer 1

您可以在选择该选项卡(而不是 iframe)时复制页面发出的 xhr 请求。我使用剪贴板将表格复制到 Excel。注意:我使用的网址来自我们的讨论。此信息应反射(reflect)在问题中。

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