简体   繁体   中英

Copy website data using VBA

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.

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM