使用VBA复制网站数据

Question

I want to get some data from a webpage, this data contains a 'ClassName'. The name of the Class is "oem". Below here you'll find an example of one page:

<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>

I want to copy all the 'OEM' data, under each other in an excel sheet. I started with the following code, which is working so far for only 1 row:

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

I know that if you change the value of the holding class from 0 to 1 or 2, you'll get the second or third value. Unfortunately every page has a different amount of OEM values. I would like that my script count the amount of 'li class="oem"' , and copy these values under eachother in an excel sheet.

Answer 1

You can get all the elements which belong to the same ClassName in an element collection and then iterate through them.

Please give this a try...

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

Answer 2

Try this. It will fetch you all the values you are after.

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