1

I have made the macros script which retrieves the data from the URL. What I need is that, I need to increase the date one by one and get the data for each. the URL is like this :

  https://www.ukdogracing.net/racecards/01-05-2017/monmore

Ia m able to get the data with this script :

  Sub GetData()
    Dim IE As Object
    Dim doc As Object
    Dim strURL As String
    Dim I As Integer

    For I = 1 To 5
    strURL = "https://www.ukdogracing.net/racecards/01-05-2017/monmore" + Trim(Str(I))

    Set IE = CreateObject("InternetExplorer.Application")
    With IE

    .navigate strURL
    Do Until .ReadyState = 4: DoEvents: Loop
    Do While .Busy: DoEvents: Loop
    Set doc = IE.Document
    GetAllTables doc

    .Quit

    End With
    Next I

    End Sub


    Sub GetAllTables(doc As Object)

    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim I As Long
    Dim ThisLink As Object 'variable for <a> tags
    Set ws = Worksheets.Add

    For Each tbl In doc.getElementsByTagName("TABLE")
        tabno = tabno + 1
        nextrow = nextrow + 1
        Set rng = ws.Range("B" & nextrow)

        rng.Offset(, -1) = "Table " & tabno
        For Each rw In tbl.Rows
            For Each cl In rw.Cells
                rng.Value = cl.outerText
                Set rng = rng.Offset(, 1)
                I = I + 1
            Next cl
        nextrow = nextrow + 1
        Set rng = rng.Offset(1, -I)
        I = 0
        Next rw
    Next tbl

    I = Range("B" & Rows.Count).End(xlUp).Row 'last row with data

    Do While Cells(I, 1).Value = "" 'will loop until first not blank found in column A (starting from last row of data, from end to start)
        For Each ThisLink In doc.getElementsByTagName("a") 'we check all <a> tags
            If ThisLink.innerText = Cells(I, 2).Value Then Cells(I, 1).Value = ThisLink.href 'If the innertext is the name of the race, in column A we add link
        Next ThisLink
        I = I - 1 'we decrease row position
    Loop
    End Sub

But I need the script takes the date part of the URL and add one day each time till today and get the data. for example :

 https://www.ukdogracing.net/racecards/01-06-2017/monmore 

 https://www.ukdogracing.net/racecards/01-07-2017/monmore

etc... How can I make the script to get the data for each day adding one each time.

Thanks in advance.

Community
  • 1
  • 1
Orkhan Orkhan
  • 83
  • 2
  • 8
  • 1
    How are you getting your dates? are you picking them up from cells or you just them in an array? – Zac Mar 01 '18 at 14:44
  • I dont need to get the date in the retrieved data. in the url the dates are mentioned. and each url with different date contains different statistics. so what I need is to force the script to check all the dates which is in the URL and do the same thing like above script. in the above script I am able to do the job. script gets the all required data for me (https://www.ukdogracing.net/racecards/01-05-2017/monmore) but I need the script does not stop but try new date adding one day each time to the url and get the data. – Orkhan Orkhan Mar 01 '18 at 14:47
  • what's the `I` for in the first Sub? Is it serving a purpose? – ashleedawg Mar 01 '18 at 15:07
  • Actually I adapted the code to my need .. that does not need. – Orkhan Orkhan Mar 01 '18 at 15:16

1 Answers1

0

Replace the first sub with this one and it will run for the specified dates. I couldn't see I having any purpose so i removed it.

Sub GetData()
    Dim IE As Object, doc As Object
    Dim strURL As String, myDate As Date

    Set IE = CreateObject("InternetExplorer.Application")
    With IE

        For myDate = CDate("01-05-2017") To CDate("01-09-2017")

            strURL = "https://www.ukdogracing.net/racecards/" & Format(myDate, "mm-dd-yyyy") & "/monmore" ' Trim(Str(I))
            .navigate strURL
            Do Until .ReadyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
            Set doc = IE.Document
            GetAllTables doc

        Next myDate

        .Quit
    End With
End Sub
ashleedawg
  • 18,752
  • 7
  • 68
  • 96
  • You're welcome. That's the 3rd dog-racing form-scraping question I've seen in the last day. Is it the beginning of "dog season" or something?! – ashleedawg Mar 01 '18 at 15:42
  • oh --- [you](https://stackoverflow.com/q/49028178/8112776) were one of the other two... If you win big, don't forget to give us all our cuts :) In the meantime, I'll graciously accept an **▲upvote** to go with that accepted answer. :-) (you have enough Rep now!) – ashleedawg Mar 01 '18 at 15:45
  • I will definitely.. I am a master in statistics :) and I think I found something new way to win for the chance rate if 99,9%. – Orkhan Orkhan Mar 01 '18 at 17:33
  • Looking forward to being taken out for dinner :-) – QHarr Mar 01 '18 at 19:59