时间戳

首页 > 解决方案 > VBA：如何将 MSXML2.XMLHTTP60 响应连接到 IHTMLDocument(iframe)

excel - VBA：如何将 MSXML2.XMLHTTP60 响应连接到 IHTMLDocument(iframe)

问题描述

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

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

但是我不知道如何将文档保存为 XML 格式（以利用其速度），同时在没有浏览器（即硒）帮助的情况下单击文档中的元素。即使在此网页上单击某些选项卡（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）

标签： excelvbaweb-scraping

解决方案

您可以在选择该选项卡（而不是 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

推荐阅读