Excel vba scraper - guidance

[Anka]

Hi all,

I think this is the most hilarious praser you've seen so far.
Just that I was able to understand, up till now.
Now, I want to get the date and hour, but i don't can...
If someone has the time to give some directions, I thank her in advance.

And this is my code.

Sub ParseHTML2()
Dim htm As Object: Set htm = CreateObject("htmlfile")
Dim tr As Object
Dim doc As HTMLDocument
Sheets("Sheet2").Activate
    Range("A1:O1").ClearContents
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://www.betexplorer.com/soccer/netherlands/eerste-divisie-2014-2015/den-bosch-almere-city/I7kIHAQP/", False
        .send
        htm.body.innerHTML = .responseText
    End With
    
        'aa = htm.getElementsByTagName("a")(52).innerText   'ok
        'Sheets("Sheet2").Range("A1").Value = aa
        ab = htm.getElementsByTagName("div")(13).getElementsByTagName("li")(2).innerText ' ok
        Sheets("Sheet2").Range("A1").Value = ab
        
        ag = htm.getElementsByTagName("h1")(0).innerText  ' ok
        Sheets("Sheet2").Range("B1").Value = ag
        
        ac = htm.getElementsByTagName("h2")(0).innerText  'ok
        Sheets("Sheet2").Range("D1").Value = ac
        ad = htm.getElementsByTagName("h2")(2).innerText ' ok
        Sheets("Sheet2").Range("E1").Value = ad
        
        ar = htm.getElementById("match-date").innerText  ' ???
        Sheets("Sheet2").Range("C1").Value = ar
               
        ae = htm.getElementById("js-score").innerText    ' ok
        Sheets("Sheet2").Range("F1").Value = ae
        af = htm.getElementById("js-partial").innerText  'ok
        Sheets("Sheet2").Range("G1").Value = af
        
End Sub

 

[tonyyy]

Anka,

You might try the following...

ar = htm.getElementById("match-date").getAttribute("data-dt")
Sheets("Sheet2").Range("C1").Value = ar

Cheers,

tonyyy

 

[Anka]

Tonyyy,

Thanks for your prompt response.
Is almost there.

Everything I've done so far has been to understand how this VBA work.
But I think I have another problem now.
In Sheet1, column D2: D & last row, I have several similar links.
What I need to do to get data from all links in that range?
Thank you.

 

[tonyyy]

Sub ParseHTML2()
Dim htm As Object: Set htm = CreateObject("htmlfile")
Dim tr As Object
Dim doc As HTMLDocument
Dim arr As Variant
Dim r As Range
Dim i As Long
i = 0
Sheets("Sheet2").Range("A1").CurrentRegion.ClearContents
For Each r In Sheets("Sheet1").Range("D2:D" & Sheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row)
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", r.Value, False
        .send
        htm.body.innerHTML = .responseText
    End With
    i = i + 1
    'aa = htm.getElementsByTagName("a")(52).innerText   'ok
    'Sheets("Sheet2").Range("A1").Value = aa
    ab = htm.getElementsByTagName("div")(13).getElementsByTagName("li")(2).innerText ' ok
    Sheets("Sheet2").Range("A" & i).Value = ab
    
    ag = htm.getElementsByTagName("h1")(0).innerText  ' ok
    Sheets("Sheet2").Range("B" & i).Value = ag
    
    ac = htm.getElementsByTagName("h2")(0).innerText  'ok
    Sheets("Sheet2").Range("D" & i).Value = ac
    ad = htm.getElementsByTagName("h2")(2).innerText ' ok
    Sheets("Sheet2").Range("E" & i).Value = ad
    
    ar = htm.getElementById("match-date").getAttribute("data-dt")  ' ???
    Sheets("Sheet2").Range("C" & i).Value = ar
    arr = Split(Range("C" & i).Value, delimiter:=",")
    If arr(0) < 10 Then arr(0) = "0" & arr(0)
    Range("C" & i) = arr(0) & "." & arr(1) & "." & arr(2) & " - " & arr(3) & ":" & arr(4)
    
    ae = htm.getElementById("js-score").innerText    ' ok
    Sheets("Sheet2").Range("F" & i).Value = "'" & ae
    af = htm.getElementById("js-partial").innerText  'ok
    Sheets("Sheet2").Range("G" & i).Value = af
Next r
Columns.AutoFit
End Sub

 

[Anka]

Yes, that's it ! Nice work, Tonyyy !
Thank you very much.

 

[tonyyy]

You're welcome, Anka. Glad it worked out.