html - 使用 VBA 复制网站数据

Question

我想从网页获取一些数据，这些数据包含一个“ClassName”。类的名称是“oem”。您将在下面找到一个页面的示例:

<div class="part">
      <h2>HF151<span class="filter-type"> [Oil Filter]</span></h2>
<div class="images">
      <a href="fileadmin/code/images/large/HF151 Oil Filter 2017_03_13-scr.jpg" class="hf-drawing" rel="lightbox" title="">
              <img height="185" src="fileadmin/code/images/small/HF151 Oil Filter 2017_03_13-wtm.jpg"></a>
      <a href="fileadmin/code/images/drawings_large/HF151.png" class="hf-drawing" rel="lightbox" title="">
              <img height="185" src="fileadmin/code/images/drawings_small/HF151.png"></a>     </div>
      <h3>Replaces OEM numbers:</h3>
      <ul class="oems">
      <li class="oem">Aprilia 0256185</li>
      </ul>

      <ul class="oems">
      <li class="oem">BMW 11 41 2 343 118</li>
      </ul>

      <ul class="oems">
      <li class="oem">BMW 11 41 2 343 452</li>
      </ul>

      <ul class="oems">
      <li class="oem">Bombardier 711256185</li>
      </ul>

      <ul class="oems"><
      li class="oem">Husqvarna 7700180</li>
      </ul>

      <div style="clear: both"></div>
      </div>

我想将所有“OEM”数据复制到 Excel 工作表中。我从以下代码开始，到目前为止该代码仅适用于 1 行:

Sub ImportCrossreferenceData()

Dim IE As InternetExplorer
Dim html As HTMLDocument

Set IE = New InternetExplorer
IE.Visible = False
IE.Navigate "http://www.hiflofiltro.com/catalogue/filter/HF151"

'Wait until IE is done loading page
Do While IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop

'Get Data
Set html = IE.document
Set holdingsClass = html.getElementsByClassName("oem")
Range("A1").Value = holdingsClass(0).textContent

'Quit and clean
IE.Quit
Set IE = Nothing

End Sub

我知道，如果将持有类的值从 0 更改为 1 或 2，您将获得第二个或第三个值。不幸的是，每个页面都有不同数量的 OEM 值。我希望我的脚本能够计算 'li class="oem"' 的数量，并将这些值复制到 Excel 工作表中的彼此下方。

Answer 1

您可以获取元素集合中属于同一ClassName的所有元素，然后迭代它们。

请尝试一下...

Sub ImportCrossreferenceData()

Dim IE As InternetExplorer
Dim html As HTMLDocument
Dim holdingsClasses As IHTMLElementCollection
Dim holdingsClass As IHTMLElement
Dim cell As Range
Dim lr As Long

Set IE = New InternetExplorer
IE.Visible = False
IE.Navigate "http://www.hiflofiltro.com/catalogue/filter/HF151"

'Wait until IE is done loading page
Do While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop

'Get Data
Set html = IE.document
Set holdingsClasses = html.getElementsByClassName("oem")

Set cell = Range("A1")

For Each holdingsClass In holdingsClasses
    cell.Value = holdingsClass.innerText
    Set cell = cell.Offset(1)
Next holdingsClass

lr = Cells(Rows.Count, 1).End(xlUp).Row

'Split column A data into columns using space as delimiter. Delete if not required
Range("A1:A" & lr).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True
IE.Quit
Set IE = Nothing

End Sub