OZmium Sports Betting and Horse Racing Forums

#21

4th February 2012, 02:10 PM

Shaun

Member

Join Date: Jan 1970

Location: Western Australia

Posts: 3,456

Yeah i tried that but file was to big so i cropped it, guess i made it to small.

Trial version Office 2010 i can explain at a later date how to extend for 6 months free use.

http://technet.microsoft.com/en-us/evalcenter/ee390818

650MB download so depending on your connection speed my take some time.

#22

4th February 2012, 07:13 PM

norisk

Member

Join Date: Dec 2011

Posts: 334

Thanks for your posts guys, been swamped but hope to have a look at it all next week.

#23

5th February 2012, 11:00 AM

norisk

Member

Join Date: Dec 2011

Posts: 334

Anyone got an idea what is wrong with the following code? Cell A1 contains the date, E1 the 1st letter of the race code eg "M', D1 the race number in 2 digit format eg '01', - as nothing happens when I run it.

Code:

Sub Victab_odds()

    
        
     With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.tab.com.au/Racing/Betting/StandardBets/PlaceStandardBet.aspx?State=1&MeetingCode=" & ActiveSheet.Range("E1").Value & "RacingCode=R&FromDate=" & Format(ActiveSheet.Range("A1").Value, "/yyyy/mm/dd/") & "T00:00:00&DisplayType=FinalDividendView&RaceNumber=" & ActiveSheet.Range("D1").Value, Destination:=Range("$A$3"))
             
        
              
        .Name = "PlaceStandardBet.aspx?State=1&MeetingCode=" & ActiveSheet.Range("E1").Value & "RacingCode=R&FromDate=" & Format(ActiveSheet.Range("A1").Value, "/yyyy/mm/dd/") & "T00:00:00&DisplayType=FinalDividendView&RaceNumber=" & ActiveSheet.Range("D1").Value
        
        

        
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """BetGrid_DGTableOne2"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
   
    
    End With
End Sub

#24

5th February 2012, 01:15 PM

Shaun

Member

Join Date: Jan 1970

Location: Western Australia

Posts: 3,456

I had a look at your code and found a few errors but after i fixed them i still couldn't get it to work.

Sometimes this happens and because i don't know heaps about macros i came up with another way of doing this.

What i do is create the url i need on the sheet and add the variables there, the good thing about doing this is you can see the results and check it with the original to find problems.

So here is what i have

Adjust the sheet to match where you want the info.

A1 =Today() this will put today's date or you could just put a date.
C1 you put the race number in single digit form
D1 =IF(C1<10,0&C1,C1)
E1 you put the letter of the meeting such as M
F1 ="http://www.tab.com.au/Racing/Betting/StandardBets/PlaceStandardBet.aspx?State=1&MeetingCode="&E1&"T&RacingCode=R&FromDate="&TEXT(A1,"yyyy-mm-dd")&"T00:00:00&BetType=Win&RaceNumber="&D1

here is the code you need to put in the VBA sheet

Code:


Sub Victab_odds()
 Sheets("sheet1").Range("A3:AZ100").Select
 Selection.ClearContents
 Sheets("sheet1").Range("A1").Select
 With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & Sheets("Sheet1").Range("F1"), Destination:=Sheets("Sheet1").Range("$A$3"))
        .Name = False
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """BetGrid_DGTableOne"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
   
    
    End With
End Sub

#25

5th February 2012, 01:27 PM

Shaun

Member

Join Date: Jan 1970

Location: Western Australia

Posts: 3,456

To remove the actual hyperlink right click the cell and select " Remove Hyperlinks"

If you don't want to see the url just reformat the text in that cell to the colour whte or what ever the background colour is.

Last edited by Shaun : 5th February 2012 at 01:31 PM.

#26

5th February 2012, 02:21 PM

norisk

Member

Join Date: Dec 2011

Posts: 334

Thanks Shaun, I made a few adjustments mainly so I can use it on any worksheet & also adjusted the url to -

="http://www.tab.com.au/Racing/Betting/StandardBets/PlaceStandardBet.aspx?State=1&MeetingCode="&E1&"&RacingCode=R&FromDate="&TEXT(A1,"yyyy-mm-dd")&"T00%3a00%3a00&RaceNumber="&D1

Code:

Sub Victab_odds()

With activesheet.Range("A3:AZ100").Select
 
 Selection.ClearContents
 activesheet.Range("A1").Select
 
 With activesheet.QueryTables.Add(Connection:= _
        "URL;" & activesheet.Range("F1"), Destination:=activesheet.Range("$A$3"))
        .Name = False
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """BetGrid_DGTableOne"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
   
    End With
    End With
    
End Sub

#27

5th February 2012, 02:28 PM

Shaun

Member

Join Date: Jan 1970

Location: Western Australia

Posts: 3,456

THE BASICS PART 3

Now we have a couple of ways to get info in to the sheet we need to make it more efficient, this will also speed up the time it takes to import.

We need to add a couple new macros to the sheet, these macro should be added to the top of the sheet before the inport macros or any other macros you have added.

Code:


Public Function ExecuteWebRequest(url As String) As String
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    oXHTTP.Open "GET", url, False
    oXHTTP.send
    ExecuteWebRequest = oXHTTP.responseText
    Set oXHTTP = Nothing
End Function

Code:


Public Function outputtext(text As String)
Dim MyFile As String, fnum As String
        MyFile = ThisWorkbook.Path & "\temp.txt"
        fnum = FreeFile()
        Open MyFile For Output As fnum
        Print #fnum, text
        Close #fnum
End Function

The first code uses the MSXML2.XMLHTTP procedure to import the info, this is what I understand it does but I may be wrong.

The second code downloads your info to a temp file.

You need to make changes to your web query to use these 2 codes, if we use the above code to import the Vic tab odds these are the changes we need to make.

Sheet1 has your variable info
Sheet2 has your imports

Code:


Sub Race()
Application.ScreenUpdating = False ‘ this stops the screen updating while it runs macro
Sheets("Sheet2").Select ‘ selects the sheet you want to import to
Range("A1:Z100").Select ‘ selects the range
Selection.ClearContents ’ clears the range
formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Sheet1").Range("F1").Value) ‘; this is the sheet and range where you have created the url as explained 
outputtext (formhtml)
Set temp_qt = ThisWorkbook.Sheets("sheet2").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("sheet2").Range("$A$1"))
    With temp_qt
        .Name = False
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """BetGrid_DGTableOne"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
‘this section will delete the temp file and remove all connections from the workbook
    ActiveSheet.QueryTables.Item(1).Delete
    Set temp_qt = Nothing
    Kill ThisWorkbook.Path & "\temp.txt"
    If ThisWorkbook.Connections.Count > 0 Then ThisWorkbook.Connections.Item(ThisWorkbook.Connect  ions.Count).Delete
    Sheets("Sheet1").Activate
    Application.ScreenUpdating = True ‘ reactivates screen updating
End Sub

I would be a good time to add a button to sheet1 that runs the macro, if you want this all on the one sheet that's fine just make sure you adjust the the first section that clears the sheet to start at say A3 and also adjust the Destination to A3 and also change sheet2 to sheet1

#28

5th February 2012, 02:39 PM

Shaun

Member

Join Date: Jan 1970

Location: Western Australia

Posts: 3,456

norisk - that's fine, once you have the idea and it works you can make a lot of different changes to suit the site you want to use it on and the info you need.

I have posted many sheets on here with different things i have added but with this basic steps most people should be able to get web query's up and running.

#29

5th February 2012, 03:30 PM

norisk

Member

Join Date: Dec 2011

Posts: 334

Good stuff Shaun, the speed difference is impressive even with such a small query.

#30

5th February 2012, 08:24 PM

Shaun

Member

Join Date: Jan 1970

Location: Western Australia

Posts: 3,456

The one main issue with doing this way is you lose the ability to refresh unless you run the macro again, I have not had a lot to do with refreshing a macro as I have not needed it so far but here is an option for auto refresh.

Add this code to the bottom of the module.

Code:

 Sub RepeatMacro()
    Dim lastRunTime
    Do
        lastRunTime = Now
        Range("A2") = "Last run: " & Format(lastRunTime, "hh:nn:ss")
        Call Race
        DoEvents
        Application.Wait lastRunTime + TimeValue("00:00:01")' change the time to adjust the refresh rate
    Loop
End Sub

Then you need to create 2 buttons to click so do this, select excel sheet where you have the race options , go to the top panel look for “Developer” if developer is not shown go to “File”/“Options”/”Customize Ribbon” and make sure it is checked on the right hand panel.
Select “Developer” then “Insert” then select “Command Button” in ActiveX Controls. Paste the button on the page then double click it then paste this between the top and botton line.

Code:


Call RepeatMacro

Repeat instructions to create another button and double click it and paste this in.

Code:


MsgBox "Stopped."
    End

You can then rename the buttons “StartButton” and “StopButton” you then need to activate them by pressing design mode to turn it off.
You can adjust the refresh time in “RepeatMacro” just press the buttons to start and stop refresh, you need to stop refresh before changing the race when you hit start it will switch races.

Thread Tools	Search this Thread
Show Printable Version Email this Page	Search this Thread: Advanced Search
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

	To advertise on these forums, e-mail us.