使用VBA和IE从内网HTML页面提取数据遇阻求助

作为办公室职员，刚接触VBA和HTML，昨天花了一整天想实现从内网网页自动导入信息，替代手动复制粘贴，长期来看能大大提升效率。

一开始试了Power Query，但它识别不了我需要的表格，所以转向VBA方案。用MsServer工具抓页面的时候，因为需要先授权，结果报错了。后来想到IE的Cookie里保存了登录信息，就尝试用IE来实现，写了下面这段代码：

Sub ExtractFromEndeca()
 Dim ie As InternetExplorer
 Dim html As IHTMLDocument
 Set ie = CreateObject("InternetExplorer.Application")
 ie.Visible = False
 ie.Navigate "intranet address"
 While ie.Busy
 DoEvents
 Wend
 While ie.ReadyState < 4
 DoEvents
 Wend
 Set Doc = CreateObject("htmlfile")
 Set Doc = ie.document
 Set Data = Doc.getElementById("findSimilarOptions2")
 Sheet1.Cells(1, 1) = Data
 ie.Quit
 Set ie = Nothing
 ThisWorkbook.Sheets(1).Cells(1, 1) = Data
End Sub

运行后单元格A1只显示[object]，而且我也不确定有没有通过登录验证。

下面是我要提取的页面片段，希望能把这些内容输出成表格：

<td valign="top" id="findSimilarOptions2">
 <div class="subtitle">Part Attributes</div>
 <input type="checkbox" id="n_200012" value="-19192896" NAME="n_200012">
 <b> ASSY TYPE</b>&nbsp;&gt; Component<br>
 <input type="checkbox" id="n_200013" value="-18148519" NAME="n_200013">
 <b> PARAMETER I NEED(1)</b>&nbsp;&gt; VALUE I NEED(1)<br>
 <input type="checkbox" id="n_200006" value="-20823731" NAME="n_200006">
 <b> PARAMETER I NEED(2)</b>&nbsp;&gt; VALUE I NEED(2)<br>
 <input type="checkbox" id="n_200006" value="-20823618" NAME="n_200006">
 <b> PARAMETER I NEED(3)</b>&nbsp;&gt; VALUE I NEED(3)<br>
 <input type="checkbox" id="n_200006" value="-20823586" NAME="n_200006">
 <b> PARAMETER I NEED(4)</b>&nbsp;&gt; VALUE I NEED(4)<br>
 ...

问题分析 #

• 直接把DOM对象赋值给单元格会显示[object]，因为Excel单元格只能识别文本内容，无法直接存储HTML元素对象。
• 无法确认登录状态：可以临时把ie.Visible = False改为True，手动查看IE窗口是否成功加载登录后的页面，验证授权是否生效。

修改后的代码 #

Sub ExtractFromEndeca()
    Dim ie As InternetExplorer
    Dim doc As IHTMLDocument
    Dim targetElement As IHTMLElement
    Dim childNodes As IHTMLDOMChildrenCollection
    Dim node As IHTMLDOMNode
    Dim rowNum As Integer
    Dim paramText As String, valueText As String
    Dim textParts() As String
    
    ' 初始化IE，先设为可见确认登录状态
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True ' 先改成True，确认登录后再改回False
    ie.Navigate "intranet address"
    
    ' 等待页面完全加载
    Do While ie.Busy Or ie.ReadyState <> 4
        DoEvents
    Loop
    
    Set doc = ie.document
    Set targetElement = doc.getElementById("findSimilarOptions2")
    If targetElement Is Nothing Then
        MsgBox "未找到目标元素"
        ie.Quit
        Set ie = Nothing
        Exit Sub
    End If
    
    rowNum = 1
    Set childNodes = targetElement.childNodes
    
    ' 遍历子节点提取文本
    For Each node In childNodes
        ' 筛选出包含参数和值的文本节点（排除div和input元素）
        If node.NodeType = 3 And Trim(node.NodeValue) <> "" Then
            paramText = Trim(node.NodeValue)
            ' 分割参数和值
            textParts = Split(paramText, ">")
            If UBound(textParts) >= 1 Then
                Sheet1.Cells(rowNum, 1) = Trim(textParts(0))
                Sheet1.Cells(rowNum, 2) = Trim(textParts(1))
                rowNum = rowNum + 1
            End If
        End If
    Next node
    
    ie.Quit
    Set ie = Nothing
    MsgBox "数据提取完成！"
End Sub

代码说明 #

• 先把IE设为可见，方便你确认页面是否成功登录加载，等验证没问题后再改回False。
• 不再直接赋值DOM对象，而是遍历目标元素的子节点，提取纯文本内容。
• 通过Split函数分割参数和值，分别放到Excel的A列和B列，形成规范的表格。
• 添加了目标元素判断，如果找不到会弹出提示，避免代码报错中断。

内容的提问来源于stack exchange，提问作者Andrey Rassanov