如何使用 VBA 从 HTML 标记中提取值以在 Excel 中使用？答案

【问题标题】：How to extract values from HTML tags with VBA to use in Excel?如何使用 VBA 从 HTML 标记中提取值以在 Excel 中使用？
【发布时间】：2021-07-17 03:44:06
【问题描述】：

sn-p总结：（第一个li-tag打开显示内容，其他li-tag相同，只是dd-tag中的值不同。

<body id=“WEBSITE“>
 <div> id="layout" class="  MAIN SECTION "</div>
  <main>
  <ul id=“RESULTS“>
  <li class="content" style="position:relative;">
  <dl>
   <dt class="first">HEAD01:</dt>
   <dd>VALUE01</dd>
   <dt class="first"> HEAD02:</dt>
   <dd> VALUE02</dd>
   <dt class="first"> HEAD03:</dt>
   <dd> VALUE03</dd>
   <dt class="first"> HEAD04:</dt>
   <dd> VALUE04</dd>
  </dl>
 </li>
<li class="content" style="position:relative;">… </li>
 <li class="content" style="position:relative;">… </li>
 <li class="content" style="position:relative;">… </li>
 <li class="content" style="position:relative;">… </li>
</ul>
</main>
</body>

li-tags 包含一个对象的不同属性，每个对象具有相同的标题 HEAD01、02、03 和 04（在“dt”下），每个 li-tag 中的 VALUE 不同（在“ dd”）。我没有成功提取标签中的 VALUE，使得它们在 Excel 中列为相应标题下的列值，即 Excel 表中 HEAD01 下所有 li.dd-tags 中的 Value01。

我的代码：

Public Sub GetData()

    Const url = "URL"
    Dim html As New HTMLDocument, Htmldoc As New HTMLDocument
    Dim RecsCnt As Object, x As Long
       
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        html.body.innerHTML = .responseText
    End With
                                   
     Set RecsCnt = html.querySelectorAll("li")
    'Set RecsCnt = html.querySelectorAll("dl")
    
    With ActiveSheet

       For x = 0 To RecsCnt.Length - 1
        .Cells(x + 2, 2) = html.querySelectorAll("dd").Item(0).innerText
       Next
        
    End With

End Sub

有没有人有一个有效的想法？谢了

【问题讨论】：

标签： html excel vba web-scraping queryselector

【解决方案1】：

这应该会为您提供所需的数据 - 您只需要调整格式即可：

Sub Get_Text_from_website()

Dim IE As New InternetExplorer
With IE
    .Visible = True
    .navigate "https://versteigerungspool.de/amtsgericht/celle.92437/suche"
    While .Busy Or .readyState < 4: DoEvents: Wend
    Dim j As Long
    Dim element As Object, i As Long
    Set dtElements = IE.document.getElementsByTagName("dt")
    Set ddElements = IE.document.getElementsByTagName("dd")

    For Each element In dtElements
        ActiveSheet.Cells(i + 1, 1) = element.innerText
        i = i + 1
    Next

    For Each element In ddElements
        ActiveSheet.Cells(j + 1, 2) = element.innerText
        j = j + 1
    Next

    IE.Quit
End With

结束子

【讨论】：

感谢您的好意，但我自己已经去过那里，结果不是我在上面的 Excel 图片中显示的结果。使用您的代码，我在第一列 (A) 中重复了 HEAD01,02, 03 和 HEAD01,02, 03 等，并且在第二列 (B) 中所有值都在彼此之下！玩弄格式化不会轻易解决问题
您能否将预期结果与网站上的实际值粘贴在一起，因为我认为我不完全理解您的预期结果。

【解决方案2】：

如果html如图所示，使用id和class会得到更快的结果；您可以检索标题并链接 nextSibling 以移动到相邻元素。请注意：这是为标题 + 1 行运行的设置。如果还有更多，请更新 html 以反映这一点。

Option Explicit

Public Sub GetData()

    Const URL = "URL"
    Dim html As MSHTML.HTMLDocument, x As Long
       
    Set html = New MSHTML.HTMLDocument
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        html.body.innerHTML = .responseText
    End With

    With html.querySelectorAll("#RESULTS .first")
        
        For x = 0 To .Length - 1
            ActiveSheet.Cells(1, x + 1) = .Item(x).innerText
            ActiveSheet.Cells(2, x + 1) = .Item(x).NextSibling.NextSibling.innerText
        Next
        
    End With

End Sub

【讨论】：

你的代码总是比我的更有效，我会替换...谢谢！顺便说一句，我开始非常喜欢你的提示：regex101.com/r/WAJqAh/1 ... 已经帮助了我很多！