使用VBA复制网站数据

问题描述 投票:2回答:2

我想从网页上获取一些数据,这些数据包含一个'ClassName'。 Class的名称是“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>

我想在Excel工作表中复制所有'OEM'数据。我从以下代码开始,到目前为止只有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表中将这些值复制到彼此之下。

html excel vba excel-vba
2个回答
2
投票

你可以在ClassName中获得属于同一个element collection的所有元素,然后迭代它们。

请试一试......

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

2
投票

试试这个。它将获取您所追求的所有值。

Sub Oem_Value()

    Dim post As Object

    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "http://www.hiflofiltro.com/catalogue/filter/HF151"
        While .readyState < 4: DoEvents: Wend
        For Each post In .document.getElementsByClassName("oem")
            r = r + 1: Cells(r, 1) = post.innerText
        Next post
        .Quit
    End With

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.