Li class and ul class import to excel

[fredrerik84]

Hi guys , thanks to all the help i have gotten here im able to imort most data from web pages I can find. The standard code I use is something like this:

Sub Wwebdownload()
    Dim IE As New SHDocVw.InternetExplorer
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim HTMLRows As MSHTML.IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    Dim Doc As HTMLDocument
    Dim i As Long
    Dim j As Long
    Dim lr As Long
    Dim sheet As Worksheet
    Dim wb As Worksheet
    Set sheet = ActiveWorkbook.sheets("Data")
    Set wb = ActiveWorkbook.sheets("Failsafe")
    
    
    Const URL As String = ""
    
    IE.Navigate URL
    IE.Visible = True
    
    With IE
        Do While .Busy Or .readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
    End With
    
    Set Doc = IE.document
    Set HTMLRows = Doc.getElementsByTagName("td")
    
     j = 1
     For i = 1 To HTMLRows.Length
         wb.Cells(j, "B").Value = HTMLRows(i).Cells(i).innerText
         j = j + 1
     Next i


End Sub

But Im trying to extract data from a site here that uses li class and ul classes. I have been trying some different thing but so far I get nothing into excel also no error code

What do I need to do to import li classes, I tried something like this:

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Set HTMLRows = Doc.getElementsByTagName("li")

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Set HTMLRows = Doc.getElementsByTagName("ul")</code>

But dosnt work :/ the ul class im trying to import is called "runners" any help would be great </code>

 

[Domenic]

Try...

    Dim ul As MSHTML.HTMLUListElement
    Dim li As MSHTML.HTMLLIElement
    
    For Each ul In Doc.getElementsByTagName("ul")
        If ul.getAttribute("class") = "runners" Then
            For Each li In ul.getElementsByTagName("li")
                Debug.Print li.innerText
            Next li
        End If
    Next ul

Hope this helps!

 

[fredrerik84]

Try...

    Dim ul As MSHTML.HTMLUListElement
    Dim li As MSHTML.HTMLLIElement
    
    For Each ul In Doc.getElementsByTagName("ul")
        If ul.getAttribute("class") = "runners" Then
            For Each li In ul.getElementsByTagName("li")
                Debug.Print li.innerText
            Next li
        End If
    Next ul

Hope this helps!

Hi thanks for your help Domenic. I was able to build my code. its not the best one but it does indeed work.

Option Explicit


Sub webdownload()


    Dim IE As New SHDocVw.InternetExplorer
    Dim HTMLDoc As New MSHTML.HTMLDocument
    Dim HTMLRows As MSHTML.IHTMLElementCollection
    Dim HTMLRows2 As MSHTML.IHTMLElementCollection
    Dim HTMLRows3 As MSHTML.IHTMLElementCollection
    Dim HTMLRows4 As MSHTML.IHTMLElementCollection
    Dim HTMLRows5 As MSHTML.IHTMLElementCollection
    Dim HTMLRow As MSHTML.IHTMLElement
    Dim Doc As HTMLDocument
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim lr As Long
    Dim Url As String
    Dim matched As String
    Dim wb As Worksheet
    Set wb = ActiveWorkbook.sheets("Conversion")
    Dim mycur As String
    
    If Cells(4, "O").Value = "All" Then
       Url = "https://www.betfair.com/exchange/plus/football"
    ElseIf Cells(4, "O").Value = "In-Play" Then
       Url = "https://www.betfair.com/exchange/plus/football/inplay"
    ElseIf Cells(4, "O").Value = "Today" Then
       Url = "https://www.betfair.com/exchange/plus/football/today"
    ElseIf Cells(4, "O").Value = "Tomorrow" Then
       Url = "https://www.betfair.com/exchange/plus/football/tomorrow"
    ElseIf Cells(4, "O").Value = "future" Then
       Url = "https://www.betfair.com/exchange/plus/football/future"
    ElseIf Cells(4, "O").Value = "Matched Amount" Then
       Url = "https://www.betfair.com/exchange/plus/football?group-by=matched_amount"
    End If
    
    IE.Navigate Url
    IE.Visible = True
    lr = Cells(Rows.Count, "B").End(xlUp).Row + 1
    
    Columns("E:K").NumberFormat = "General"
    Range("B" & 4 & ":M" & lr).Value = ""
    Range("B" & 4 & ":M" & lr).Interior.Color = RGB(255, 255, 255)
    Range("B" & 4 & ":M" & lr).Borders(xlEdgeTop).LineStyle = xlNone
    Range("B" & 4 & ":M" & lr).Borders(xlEdgeLeft).LineStyle = xlNone
    Range("B" & 4 & ":M" & lr).Borders(xlEdgeBottom).LineStyle = xlNone
    Range("B" & 4 & ":M" & lr).Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Application.Wait (Now + TimeValue("0:00:12"))
    
    Set Doc = IE.document
    
    Set HTMLRows = Doc.getElementsByClassName("runners")
    Set HTMLRows2 = Doc.getElementsByClassName("matched-amount")
    Set HTMLRows3 = Doc.getElementsByClassName("bet-button-price")
    Set HTMLRows4 = Doc.getElementsByClassName("cell")
    Set HTMLRows5 = Doc.getElementsByClassName("start-date-wrapper")
    
     j = 4
     k = 6
     For i = 0 To HTMLRows.Length - 1
         Cells(j, "C").Value = Trim(Split(HTMLRows(i).innerText, vbCrLf)(0))
         Cells(j, "D").Value = Trim(Split(HTMLRows(i).innerText, vbCrLf)(1))
         matched = HTMLRows2(i).innerText
         If InStr(matched, "kr") <> 0 Then
            matched = Replace(matched, "kr", "")
            matched = Replace(matched, ",", "")
            mycur = Application.VLookup("Norwegian Krone", wb.Range("B7:D60"), 3, False)
            matched = mycur * matched
            Cells(j, "E").NumberFormat = "$#,##0"
         End If
         Cells(j, "E").Value = matched
         On Error Resume Next
         Cells(j, "B").Value = Trim(Split(HTMLRows4(i).innerText, vbCrLf)(1))
         On Error Resume Next
         j = j + 1
     Next i
     
     j = 4
     For i = 0 To HTMLRows3.Length - 1
         If k = "8" Then
            k = k + 1
         End If
         If k = "11" Then
            k = k + 1
         End If
         If k = "14" Then
            k = 6
            j = j + 1
         End If
         Cells(j, k).Value = HTMLRows3(i).innerText
         k = k + 1
     Next i
     
     j = Cells(Rows.Count, "B").End(xlUp).Row + 1
     For i = 0 To HTMLRows5.Length - 1
        Cells(j, "B").Value = Trim(Split(HTMLRows5(i).innerText, vbCrLf)(0))
        On Error Resume Next
        j = j + 1
     Next i
     lr = Cells(Rows.Count, "B").End(xlUp).Row
     Range("B" & 4 & ":B" & lr).Interior.Color = RGB(234, 234, 234)
     
     Range("F" & 4 & ":F" & lr).Interior.Color = RGB(204, 229, 234)
     Range("I" & 4 & ":I" & lr).Interior.Color = RGB(204, 229, 234)
     Range("L" & 4 & ":L" & lr).Interior.Color = RGB(204, 229, 234)
     
     Range("G" & 4 & ":G" & lr).Interior.Color = RGB(255, 204, 204)
     Range("J" & 4 & ":J" & lr).Interior.Color = RGB(255, 204, 204)
     Range("M" & 4 & ":M" & lr).Interior.Color = RGB(255, 204, 204)
     
     With Range("B" & 4 & ":E" & lr).Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .Color = RGB(224, 224, 224)
         .Weight = xlThin
    End With
    
    With Range("B" & 4 & ":E" & lr).Borders(xlInsideHorizontal)
         .LineStyle = xlContinuous
         .Color = RGB(224, 224, 224)
         .Weight = xlThin
    End With
    With Range("B" & 4 & ":E" & lr).Borders(xlEdgeBottom)
         .LineStyle = xlContinuous
         .Color = RGB(224, 224, 224)
         .Weight = xlThin
    End With
    With Range("B" & 4 & ":E" & lr).Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .Color = RGB(224, 224, 224)
         .Weight = xlThin
    End With
    IE.Quit

the only line im having problem with is this one:

    Application.Wait (Now + TimeValue("0:00:12")) 

but im having a hard time getting the page the load using something like this:

    With IE
        Do While .Busy Or .readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
    End With

Also I would like to use this post to personally thanks you for all the help you provided me with in the past. Thanks to you I have been able to pull a ton of data from the web
If you see in my script here , you will see that I have 3 loops starting after each other. I was not able to have them in one with my skill level as HTMrows 3,4 and 5 have less data then HTMrow and gave me lots of error msgs. But having 3 loops sure increase the load time :/