Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Set below is the full coding which I have now cleaned up and works
satisfactorily except for Module4 (My Macro). The workbook gathers data from the web at a time interval set by the user (usually 30-60 seconds). There are three worksheets:- "Console" whereby one connects/disconnects via command buttons and where relevant information is displayed. "Latest Snapshot" where the collected data is displayed. "Chartdata" which is blank. I need to copy the data from "Latest Snapshot" (Range J3:J17) and display it in "Chartdata" (Range B2:B16) from which I can derive a chart. I have created a macro in Module4 below for copying/pasting the data into "Chartdata". Although it is a bit long winded, it works. I require the copied data to work in unison with the main macro. As you can see it copies the data every 30 seconds In the line (from Module4):- 'Application.Wait (Now + TimeValue("0:00:30"))' It does this 15 times and stops for my purposes. What I require is for my macro (Module4) to run within the main macro, so that the data is gathered, pasted in "Latest Snapshot", then copied and pasted into "Chartdata". However, the copied data when pasted into "Chartdata" needs to move along one column (C2:C16) with every copy/paste (as can be seen in Module4) for graphic purposes, so Rises and falls in data can be viewed. Apologies for previous postings about this, but it's becoming a bit cleare to me. I have just ordered the book "Excel VBA Macro Programming" by Richard Shepherd, as I'm so enthused! Thanks. ------------------------------------------------------------------------------ Module1........................................... ..... Option Explicit Sub GetExchangeShow() 'Extract and store Betfair price shows. Dim sURL, sHTML As String Const sBFMarketPrefix As String = "http://www.betfair.com/betting/LoadMarketDataAction.do?mi=" 'Mask screen redraws during automated operations. Application.ScreenUpdating = False 'Construct the full Betfair market page name from the fixed and variable parts. sURL = sBFMarketPrefix & ThisWorkbook.Worksheets("Console").Range("MarketID ").Cells(1, 1).Value 'Extract the show text. sHTML = GetExchangeData(sURL) 'Parse the betting fields from the HTML text ... ' ... and write the show into the Snapshot worksheet. CreateShow (sHTML) End Sub Sub CreateShow(sHTML) 'Extracts the event name, names of selections(<=100), back/lay prices and amounts available ... ' ... returning the results to the Snapshot worksheet via named ranges. 'We cannot continue to use the Webrowser Control because the data is held in VBscript calls. 'No problem though since the arguments are effectively quote or comma-delimited data. Dim sQuote, sAmount As String Dim StartField, EndField As Integer Dim SelectionNo, QuoteNo As Integer Dim sEName, sSels(1 To 100, 1 To 1) As String Dim sBacks(1 To 100, 1 To 3), sLays(1 To 100, 1 To 3) As String 'If something goes wrong proceed directly to copy any data gathered back to the worksheet. On Error GoTo Cb 'Extract the name of the event: the text in single quotes after the p.m_M declaration. StartField = InStr(sHTML, "p.m_M") StartField = InStr(StartField + 1, sHTML, "'") + 1 EndField = InStr(StartField + 1, sHTML, "'") - 1 sEName = Mid(sHTML, StartField, EndField - StartField + 1) 'Extract the names of up to 100 selections, the best three back and lay prices ... ' ... and the amount of money currently available at those prices. SelectionNo = 1 StartField = InStr(EndField, sHTML, "p.m_R") While StartField < 0 And SelectionNo < 101 'First the selection name between single quotes again ... StartField = InStr(StartField + 1, sHTML, "'") + 1 EndField = InStr(StartField + 1, sHTML, "'") - 1 sSels(SelectionNo, 1) = Mid(sHTML, StartField, EndField - StartField + 1) '... then the 3 back and 3 lay prices, comma delimited, skipping 2 unwanted fields ... StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 For QuoteNo = 1 To 3 'Back price ... StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sQuote = Mid(sHTML, StartField, EndField - StartField + 1) ' ... amount available. StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sAmount = Mid(sHTML, StartField, EndField - StartField + 1) sBacks(SelectionNo, QuoteNo) = sQuote & "(" & sAmount & ")" Next QuoteNo For QuoteNo = 1 To 3 'Lay price ... StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sQuote = Mid(sHTML, StartField, EndField - StartField + 1) '... amount available. StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sAmount = Mid(sHTML, StartField, EndField - StartField + 1) sLays(SelectionNo, QuoteNo) = sQuote & "(" & sAmount & ")" Next QuoteNo ' ... on to the next selection (if any). SelectionNo = SelectionNo + 1 StartField = InStr(EndField, sHTML, "p.m_R") Wend 'Copy the data collected in VBA arrays back to EXCEL ranges. Cb: ThisWorkbook.Worksheets("Latest Snapshot").Range("EventName").Value = sEName ThisWorkbook.Worksheets("Latest Snapshot").Range("Selections").Value = sSels ThisWorkbook.Worksheets("Latest Snapshot").Range("Back").Value = sBacks ThisWorkbook.Worksheets("Latest Snapshot").Range("Lay").Value = sLays 'Timestamp the data. ThisWorkbook.Worksheets("Latest Snapshot").Range("TimeStamp").Cells(1, 1).Formula = "=Now()" ThisWorkbook.Worksheets("Latest Snapshot").Range("TimeStamp").Cells(1, 2).Formula = "=Now()" End Sub Module2........................................... ....... Option Explicit Public RunWhen As Double Public RunIntervalSeconds As Integer Public Const cRunWhat = "DataRefresh" Public ShowNumber As Integer Sub EngageWeb() 'Starts up the scheduling process: in the nature of an initialisation routine. 'Check the workbook has valid sheet names allowing updates to be stored sequentially. If Not WorkSheetNameIntegrity() Then MsgBox "Show number inconsistent with existing worksheet names." Exit Sub End If 'Change some of the EXCEL colour palette to match Betfair's show scheme. SetColourScheme 'Set the data acquisition interval from the parameter worksheet cell. RunIntervalSeconds = ThisWorkbook.Worksheets("Console").Range("RefreshI nterval").Cells(1, 1).Value 'Determine the last show number. ShowNumber = ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value 'Obtain the latest show DataRefresh End Sub Sub DataRefresh() 'Acquire data, parse out the latest prices and store them away. ShowNumber = ShowNumber + 1 ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value = ShowNumber GetExchangeShow 'Prime the next refresh, up to 500 shows. If ShowNumber < 500 Then StartTimer Else DisEngageWeb End If End Sub Sub StartTimer() RunWhen = Now + TimeSerial(0, 0, RunIntervalSeconds) Application.OnTime earliesttime:=RunWhen, procedu=cRunWhat, schedule:=True End Sub Sub DisEngageWeb() 'Shuts down the scheduling process: in the nature of a closing routine. On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedu=cRunWhat, schedule:=False ThisWorkbook.ResetColors End Sub Function WorkSheetNameIntegrity() As Boolean 'The shows are stored in sheets having sequential integer names so we check that ... '... the stated number of shows gathered is not less than the maximum sheet name. 'If there are no numeric sheet names the starting show number is set to 0. Dim idx, Max, No As Integer Max = -1 For idx = 1 To ThisWorkbook.Worksheets.Count If IsNumeric(ThisWorkbook.Worksheets(idx).Name) Then No = Val(ThisWorkbook.Worksheets(idx).Name) If No Max Then Max = No End If Next If ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value < Max Then WorkSheetNameIntegrity = False Else WorkSheetNameIntegrity = True If Max = -1 Then ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value = 0 End If End Function Sub SetColourScheme() 'Alice blue for the market name. ThisWorkbook.Colors(37) = RGB(217, 232, 234) 'Light and steel blues for back prices. ThisWorkbook.Colors(33) = RGB(210, 225, 233) ThisWorkbook.Colors(41) = RGB(177, 201, 216) 'Pinkish for lay prices. ThisWorkbook.Colors(44) = RGB(234, 203, 219) ThisWorkbook.Colors(40) = RGB(228, 189, 208) End Sub Module3........................................... ................. Option Explicit Function GetExchangeData(sURL) As String 'Extract the HTML text containing the event data from the Betfair market page ... '... using the Microsoft Internet Controls (enable in VBE/Tools/References). Dim IeApp As InternetExplorer Dim IeDoc As Object Dim lStartSecs, lElapsedSecs, lTimeOutSecs As Long 'In case an unexpected error occurs ... say the user accidentally closes the show web page. 'The string returned is an error message in place of an event name, one without contestants. GetExchangeData = "p.m_M, 'Data collection failed.'" On Error GoTo cl 'Create a new instance of IE & make it visible: some things don¢t work unless it¢s visible. Set IeApp = New InternetExplorer IeApp.Visible = True 'Call up the page required ... give it time to load (90% of the refresh interval). lTimeOutSecs = RunIntervalSeconds * 0.9 lStartSecs = Timer() IeApp.Navigate sURL Do lElapsedSecs = Timer() - lStartSecs If lElapsedSecs < 0 Then lElapsedSecs = lElapsedSecs + 60 * 60 * 24 'period spanning 12A.M. Loop Until IeApp.ReadyState = READYSTATE_COMPLETE Or lElapsedSecs lTimeOutSecs If lElapsedSecs lTimeOutSecs Then GetExchangeData = "p.m_M, 'Web access timed out.'" Else 'Store the page's Document Object ... and see if it looks like a market has loaded. Set IeDoc = IeApp.Document If InStr(IeDoc.documentElement.innerHTML, "p.m_M") = 0 Then GetExchangeData = "p.m_M, 'Invalid market ID.'" Else 'Grab the text (inside the first script). GetExchangeData = IeDoc.Scripts(0).Text End If Set IeDoc = Nothing End If 'Close the IE window and clean up storage. IeApp.Quit Set IeApp = Nothing cl: lStartSecs = 0 'Couldn't find a NULL statement! End Function Module4........................................... ................... Sub The_Sub() Sheets("Latest Snapshot").Select Range("J3:J17").Select Selection.Copy Sheets("Chartdata").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("D2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("E2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("F2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("G2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("H2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("I2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("K2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("L2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("N2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("O2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) Sheets("Latest Snapshot").Select Application.CutCopyMode = False Selection.Copy Sheets("Chartdata").Select Range("P2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Wait (Now + TimeValue("0:00:30")) End Sub |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
After reading your posts so many times, we think this is what you want
for i = 1 to 15 read the web take snapshot write to cells(2, i+1) 'i+1 = B, i+2 = C, etc wait 30 sec next i your first post failed because there was no waiting, you put all 15 write in one operation. "Saxman" wrote: Set below is the full coding which I have now cleaned up and works satisfactorily except for Module4 (My Macro). The workbook gathers data from the web at a time interval set by the user (usually 30-60 seconds). There are three worksheets:- "Console" whereby one connects/disconnects via command buttons and where relevant information is displayed. "Latest Snapshot" where the collected data is displayed. "Chartdata" which is blank. I need to copy the data from "Latest Snapshot" (Range J3:J17) and display it in "Chartdata" (Range B2:B16) from which I can derive a chart. I have created a macro in Module4 below for copying/pasting the data into "Chartdata". Although it is a bit long winded, it works. I require the copied data to work in unison with the main macro. As you can see it copies the data every 30 seconds In the line (from Module4):- 'Application.Wait (Now + TimeValue("0:00:30"))' It does this 15 times and stops for my purposes. What I require is for my macro (Module4) to run within the main macro, so that the data is gathered, pasted in "Latest Snapshot", then copied and pasted into "Chartdata". However, the copied data when pasted into "Chartdata" needs to move along one column (C2:C16) with every copy/paste (as can be seen in Module4) for graphic purposes, so Rises and falls in data can be viewed. Apologies for previous postings about this, but it's becoming a bit cleare to me. I have just ordered the book "Excel VBA Macro Programming" by Richard Shepherd, as I'm so enthused! Thanks. ------------------------------------------------------------------------------ Module1........................................... ..... Option Explicit Sub GetExchangeShow() 'Extract and store Betfair price shows. Dim sURL, sHTML As String Const sBFMarketPrefix As String = "http://www.betfair.com/betting/LoadMarketDataAction.do?mi=" 'Mask screen redraws during automated operations. Application.ScreenUpdating = False 'Construct the full Betfair market page name from the fixed and variable parts. sURL = sBFMarketPrefix & ThisWorkbook.Worksheets("Console").Range("MarketID ").Cells(1, 1).Value 'Extract the show text. sHTML = GetExchangeData(sURL) 'Parse the betting fields from the HTML text ... ' ... and write the show into the Snapshot worksheet. CreateShow (sHTML) End Sub Sub CreateShow(sHTML) 'Extracts the event name, names of selections(<=100), back/lay prices and amounts available ... ' ... returning the results to the Snapshot worksheet via named ranges. 'We cannot continue to use the Webrowser Control because the data is held in VBscript calls. 'No problem though since the arguments are effectively quote or comma-delimited data. Dim sQuote, sAmount As String Dim StartField, EndField As Integer Dim SelectionNo, QuoteNo As Integer Dim sEName, sSels(1 To 100, 1 To 1) As String Dim sBacks(1 To 100, 1 To 3), sLays(1 To 100, 1 To 3) As String 'If something goes wrong proceed directly to copy any data gathered back to the worksheet. On Error GoTo Cb 'Extract the name of the event: the text in single quotes after the p.m_M declaration. StartField = InStr(sHTML, "p.m_M") StartField = InStr(StartField + 1, sHTML, "'") + 1 EndField = InStr(StartField + 1, sHTML, "'") - 1 sEName = Mid(sHTML, StartField, EndField - StartField + 1) 'Extract the names of up to 100 selections, the best three back and lay prices ... ' ... and the amount of money currently available at those prices. SelectionNo = 1 StartField = InStr(EndField, sHTML, "p.m_R") While StartField < 0 And SelectionNo < 101 'First the selection name between single quotes again ... StartField = InStr(StartField + 1, sHTML, "'") + 1 EndField = InStr(StartField + 1, sHTML, "'") - 1 sSels(SelectionNo, 1) = Mid(sHTML, StartField, EndField - StartField + 1) '... then the 3 back and 3 lay prices, comma delimited, skipping 2 unwanted fields ... StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 For QuoteNo = 1 To 3 'Back price ... StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sQuote = Mid(sHTML, StartField, EndField - StartField + 1) ' ... amount available. StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sAmount = Mid(sHTML, StartField, EndField - StartField + 1) sBacks(SelectionNo, QuoteNo) = sQuote & "(" & sAmount & ")" Next QuoteNo For QuoteNo = 1 To 3 'Lay price ... StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sQuote = Mid(sHTML, StartField, EndField - StartField + 1) '... amount available. StartField = InStr(EndField, sHTML, ",") + 1 EndField = InStr(StartField + 1, sHTML, ",") - 1 sAmount = Mid(sHTML, StartField, EndField - StartField + 1) sLays(SelectionNo, QuoteNo) = sQuote & "(" & sAmount & ")" Next QuoteNo ' ... on to the next selection (if any). SelectionNo = SelectionNo + 1 StartField = InStr(EndField, sHTML, "p.m_R") Wend 'Copy the data collected in VBA arrays back to EXCEL ranges. Cb: ThisWorkbook.Worksheets("Latest Snapshot").Range("EventName").Value = sEName ThisWorkbook.Worksheets("Latest Snapshot").Range("Selections").Value = sSels ThisWorkbook.Worksheets("Latest Snapshot").Range("Back").Value = sBacks ThisWorkbook.Worksheets("Latest Snapshot").Range("Lay").Value = sLays 'Timestamp the data. ThisWorkbook.Worksheets("Latest Snapshot").Range("TimeStamp").Cells(1, 1).Formula = "=Now()" ThisWorkbook.Worksheets("Latest Snapshot").Range("TimeStamp").Cells(1, 2).Formula = "=Now()" End Sub Module2........................................... ....... Option Explicit Public RunWhen As Double Public RunIntervalSeconds As Integer Public Const cRunWhat = "DataRefresh" Public ShowNumber As Integer Sub EngageWeb() 'Starts up the scheduling process: in the nature of an initialisation routine. 'Check the workbook has valid sheet names allowing updates to be stored sequentially. If Not WorkSheetNameIntegrity() Then MsgBox "Show number inconsistent with existing worksheet names." Exit Sub End If 'Change some of the EXCEL colour palette to match Betfair's show scheme. SetColourScheme 'Set the data acquisition interval from the parameter worksheet cell. RunIntervalSeconds = ThisWorkbook.Worksheets("Console").Range("RefreshI nterval").Cells(1, 1).Value 'Determine the last show number. ShowNumber = ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value 'Obtain the latest show DataRefresh End Sub Sub DataRefresh() 'Acquire data, parse out the latest prices and store them away. ShowNumber = ShowNumber + 1 ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value = ShowNumber GetExchangeShow 'Prime the next refresh, up to 500 shows. If ShowNumber < 500 Then StartTimer Else DisEngageWeb End If End Sub Sub StartTimer() RunWhen = Now + TimeSerial(0, 0, RunIntervalSeconds) Application.OnTime earliesttime:=RunWhen, procedu=cRunWhat, schedule:=True End Sub Sub DisEngageWeb() 'Shuts down the scheduling process: in the nature of a closing routine. On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedu=cRunWhat, schedule:=False ThisWorkbook.ResetColors End Sub Function WorkSheetNameIntegrity() As Boolean 'The shows are stored in sheets having sequential integer names so we check that ... '... the stated number of shows gathered is not less than the maximum sheet name. 'If there are no numeric sheet names the starting show number is set to 0. Dim idx, Max, No As Integer Max = -1 For idx = 1 To ThisWorkbook.Worksheets.Count If IsNumeric(ThisWorkbook.Worksheets(idx).Name) Then No = Val(ThisWorkbook.Worksheets(idx).Name) If No Max Then Max = No End If Next If ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value < Max Then WorkSheetNameIntegrity = False Else WorkSheetNameIntegrity = True If Max = -1 Then ThisWorkbook.Worksheets("Console").Range("Shows"). Cells(1, 1).Value = 0 End If End Function Sub SetColourScheme() 'Alice blue for the market name. ThisWorkbook.Colors(37) = RGB(217, 232, 234) 'Light and steel blues for back prices. ThisWorkbook.Colors(33) = RGB(210, 225, 233) ThisWorkbook.Colors(41) = RGB(177, 201, 216) 'Pinkish for lay prices. ThisWorkbook.Colors(44) = RGB(234, 203, 219) ThisWorkbook.Colors(40) = RGB(228, 189, 208) End Sub Module3........................................... ................. Option Explicit Function GetExchangeData(sURL) As String 'Extract the HTML text containing the event data from the Betfair market page ... '... using the Microsoft Internet Controls (enable in VBE/Tools/References). Dim IeApp As InternetExplorer Dim IeDoc As Object Dim lStartSecs, lElapsedSecs, lTimeOutSecs As Long 'In case an unexpected error occurs ... say the user accidentally closes the show web page. 'The string returned is an error message in place of an event name, one without contestants. GetExchangeData = "p.m_M, 'Data collection failed.'" On Error GoTo cl 'Create a new instance of IE & make it visible: some things donʼt work unless itʼs visible. Set IeApp = New InternetExplorer IeApp.Visible = True 'Call up the page required ... give it time to load (90% of the refresh interval). lTimeOutSecs = RunIntervalSeconds * 0.9 lStartSecs = Timer() IeApp.Navigate sURL Do lElapsedSecs = Timer() - lStartSecs If lElapsedSecs < 0 Then lElapsedSecs = lElapsedSecs + 60 * 60 * 24 'period spanning 12A.M. Loop Until IeApp.ReadyState = READYSTATE_COMPLETE Or lElapsedSecs lTimeOutSecs If lElapsedSecs lTimeOutSecs Then GetExchangeData = "p.m_M, 'Web access timed out.'" Else 'Store the page's Document Object ... and see if it looks like a market has loaded. Set IeDoc = IeApp.Document If InStr(IeDoc.documentElement.innerHTML, "p.m_M") = 0 Then GetExchangeData = "p.m_M, 'Invalid market ID.'" Else 'Grab the text (inside the first script). |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
On Tue, 20 Dec 2005 22:01:03 -0800, PY & Associates wrote:
After reading your posts so many times, we think this is what you want for i = 1 to 15 read the web take snapshot write to cells(2, i+1) 'i+1 = B, i+2 = C, etc wait 30 sec next i your first post failed because there was no waiting, you put all 15 write in one operation. This works fine with the help of another poster. Sub The_Sub() For i = 2 to 17 Sheets("Latest Snapshot").Range("J3:J17").Copy Sheets("Chartdata").cells(2,i).PasteSpecial Paste:=xlPasteValues Application.Wait (Now + TimeValue("0:00:30")) Next i End sub For i = 2 to 17, as I need the first column for chart reference. I just need to incorporate this routine into the main macro somehow. I dare say it will be hit and miss, as I have two timed events running simultaneously. Eventually, if I get things running smoothly (with your help!), both events will be set to the same time interval. Thanks!! Thanks for the feedback. |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
That is also ours.
2 to 17 (should be 16) is because we used cells(2, i) 1 to 15 is because we used cells(2, i+1) here you DO NOT need two 'timed' action. you only need this one. "Saxman" wrote in message ... On Tue, 20 Dec 2005 22:01:03 -0800, PY & Associates wrote: After reading your posts so many times, we think this is what you want for i = 1 to 15 read the web take snapshot write to cells(2, i+1) 'i+1 = B, i+2 = C, etc wait 30 sec next i your first post failed because there was no waiting, you put all 15 write in one operation. This works fine with the help of another poster. Sub The_Sub() For i = 2 to 17 Sheets("Latest Snapshot").Range("J3:J17").Copy Sheets("Chartdata").cells(2,i).PasteSpecial Paste:=xlPasteValues Application.Wait (Now + TimeValue("0:00:30")) Next i End sub For i = 2 to 17, as I need the first column for chart reference. I just need to incorporate this routine into the main macro somehow. I dare say it will be hit and miss, as I have two timed events running simultaneously. Eventually, if I get things running smoothly (with your help!), both events will be set to the same time interval. Thanks!! Thanks for the feedback. |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
On Wed, 21 Dec 2005 19:15:56 +0800, PY & Associates wrote:
That is also ours. 2 to 17 (should be 16) is because we used cells(2, i) 1 to 15 is because we used cells(2, i+1) here you DO NOT need two 'timed' action. you only need this one. Not sure what you mean. The data is gathered according to a user setting on the "Console" worksheet. Can they both be incorporated into one routine. (i.e. with the code below)? You should be able to see the coding for data gathering in my original post which has the full code attached. Sub The_Sub() For i = 2 to 17 Sheets("Latest Snapshot").Range("J3:J17").Copy Sheets("Chartdata").cells(2,i).PasteSpecial Paste:=xlPasteValues Application.Wait (Now + TimeValue("0:00:30")) Next i End sub Thanks again! |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
We would very much like to assist, but find it very difficult to trace
through the code without knowing the work flow. There are plenty of cosmetics (coloring, etc) which distract us. We prefer to give you logics and you put them in the right position. when data is read, it becomes static. Whether you write it immediately or a few seconds later, they do not change. You must wait a few seconds to read the data again so that they have time to refresh. so you read the web (I must look back to your OP Nearly there, with Chip's code), take a snapshot (optional), write to chartdata, one step after another, no need to pause. Now you wait before you read the web again. but you have to shift data one column to the right, so you need an increment counter i for the loop Sit back and think over it please. "Saxman" wrote in message .. . On Wed, 21 Dec 2005 19:15:56 +0800, PY & Associates wrote: That is also ours. 2 to 17 (should be 16) is because we used cells(2, i) 1 to 15 is because we used cells(2, i+1) here you DO NOT need two 'timed' action. you only need this one. Not sure what you mean. The data is gathered according to a user setting on the "Console" worksheet. Can they both be incorporated into one routine. (i.e. with the code below)? You should be able to see the coding for data gathering in my original post which has the full code attached. Sub The_Sub() For i = 2 to 17 Sheets("Latest Snapshot").Range("J3:J17").Copy Sheets("Chartdata").cells(2,i).PasteSpecial Paste:=xlPasteValues Application.Wait (Now + TimeValue("0:00:30")) Next i End sub Thanks again! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|