Timed Macros

[diggerdidoodar]

Got the following code off the forum which works great to run the macro evey 10 seconds.

What I really want is to run it at a certain time in the morning
Can anyone please help

PS:- The actual code procedure code is just a test, I don't really want to write my name 100's of times.

Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public TimerSeconds As Single

Sub StartTimer()
TimerSeconds = 10 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'
Workbooks.Open Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls"
Range("C6").Select
ActiveCell.FormulaR1C1 = "D a v I d"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C30"), Type:=xlFillDefault
Range("C6:C30").Select
Range("C6").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D6:D30"), Type:=xlFillDefault
Range("D6:D30").Select
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E6:E30"), Type:=xlFillDefault
Range("E6:E30").Select
Range("E6").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F6:F30"), Type:=xlFillDefault
Range("F6:F30").Select
Range("A3").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
'
End Sub


Cheers Diggerdi

 

[StevenD]

Try this,

It worked for me.

http://www.mrexcel.com/board2/viewtopic.php?t=132168

Just modify to suit.

[/code]

 

[diggerdidoodar]

Timed Macro's

Thanks for the reply & your reply yesterday, I noticed this coding yesterday but was none the wiser.
Where & how would I fit this into my original coding??

Cheers Diggerdi

 

[StevenD]

Hi Diggerdi,

The code that you want executed at a certain time is placed where I have written 'Do work at this point.

Then put the other code in a new module.

Changing "TheSub" to whatever your sub name is containing the time statement.

This then works by checking using the timer every 20 seconds if the time falls within the window.

Hope this helps.

 

[diggerdidoodar]

Timed Macro

A bit confused, done as you said:-

Code in Blue in a module, Code in Violet in another module but program is till running every 10 seconds, I only want it to run a a certain time.
Are the end if wrong or is it that I've a 24hr clock??:-

Hope you can help

Sub Timetest()


If Time < #1:09:59 PM# And Time > #1:11:01 PM# Then
runonce = 1
End If
If runonce = 0 Then
If Time < #1:10:00 PM# And Time > #1:11:00 PM# Then
runonce = 1

End If

Workbooks.Open Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls"
Range("C6").Select
ActiveCell.FormulaR1C1 = "D a v I d"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C30"), Type:=xlFillDefault
Range("C6:C30").Select
Range("C6").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D6:D30"), Type:=xlFillDefault
Range("D6:D30").Select
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E6:E30"), Type:=xlFillDefault
Range("E6:E30").Select
Range("E6").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F6:F30"), Type:=xlFillDefault
Range("F6:F30").Select
Range("A3").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
StartTimer


End If
End Sub

Public RunWhen As Double
Public Const cRunIntervalSeconds = 10 ' two minutes
Public Const cRunWhat = "Timetest"


Sub StartTimer()

RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub

 

[StevenD]

Hi,

Put the end if down by the other one.

It will only carry out the code inbetween now when the time is within that window.

 

[diggerdidoodar]

I've put the to end ifs at the bottom & commented out the end if under the runonce = 1, but still no success, nothings every easy.

Cheers Diggerdidoodar

 

[StevenD]

Ok bear with me and I will have another look.

 

[StevenD]

Try this

Sub timetest()
'check whether time is falls outside window if so reset runonce

If Time < st - TimeSerial(0, 0, -1) And Time > st + TimeSerial(0, 0, 61) Then
runonce = 0
End If
    'check whether time is within window
    If Time > st And Time < st + TimeSerial(0, 0, 60) Then
        'check whether process has already been done once today
        If runonce = 0 Then
            'set that process has been run within window
            runonce = 1
            Workbooks.Open Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls"
Range("C6").Select
ActiveCell.FormulaR1C1 = "D a v I d"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C30"), Type:=xlFillDefault
Range("C6:C30").Select
Range("C6").Select
Selection.Copy
Range("D6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D6:D30"), Type:=xlFillDefault
Range("D6:D30").Select
Range("D6").Select
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("E6:E30"), Type:=xlFillDefault
Range("E6:E30").Select
Range("E6").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("F6:F30"), Type:=xlFillDefault
Range("F6:F30").Select
Range("A3").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ddignum.RENOLD_GEARS\My Documents\Book2.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End If
End If


StartTimer

End Sub

The runonce ensures that it will only do it once within the window.

 

[StevenD]

Substitute st with time.

i.e #3:54:00 PM#