Set Time parameters through cell values

[TiTuS]

Hey all,

This post is in reference to the following code which was created in this discussion http://www.mrexcel.com/board2/viewtopic.php?t=234943&start=10

Option Explicit

'Change MyProcess to the programme you want to start and stop
'I used the calc.exe programme for my test
Public Const MyProcess As String = "Azureus.exe"
Public Const FilePath As String = "C:\Program Files\Azureus\"
'This is a log file to track instances of starting and stopping the process
'Remove the references to the log file, here and within the code, if you don't want this
Public Const MyFile As String = "c:\MyLog.txt"
Public Sec As Integer
Public When As Variant

Sub MyTimer()

When = Now + Sec / 60 / 60 / 24

Application.OnTime When, "MyTimer"

If Hour(Now) < 16 Then
    StartMyProcess (MyProcess)
Else
    StopMyProcess (MyProcess)
End If


'Used for testing purposes only (after setting Sec to 20 in the Workboook_Open module)
'If Minute(Now) Mod 2 = 0 Then
'    StopMyProcess (MyProcess)
'Else
'    StartMyProcess (MyProcess)
'End If

End Sub

Private Sub StopMyTimer()
    
    Application.OnTime EarliestTime:=When, Procedure:="MyTimer", schedule:=False

End Sub

Private Sub StartMyProcess(strStartThis As String)

On Error Resume Next

Dim objWMIcimv2 As Object
Dim objList As Object
Dim procID As Long
      
Set objWMIcimv2 = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\.\root\cimv2")
      
Set objList = objWMIcimv2.ExecQuery _
    ("select * from win32_process where name='" & strStartThis & "'")

If objList.Count = 0 Then
    'The process isn't running
    procID = Shell(FilePath & strStartThis, vbHide)
    Open MyFile For Append As #1
    Write #1, Now & " : Process started ok."
    Close #1
Else
    'The process has already been started
    DoEvents
    Open MyFile For Append As #1
    Write #1, Now & " : Process already started."
    Close #1
End If

Set objWMIcimv2 = Nothing
Set objList = Nothing

End Sub

Private Sub StopMyProcess(strTerminateThis As String)

On Error Resume Next

Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
Dim intError As Integer
      
Set objWMIcimv2 = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\.\root\cimv2")
      
Set objList = objWMIcimv2.ExecQuery _
    ("select * from win32_process where name='" & strTerminateThis & "'")

If objList.Count = 0 Then
    'The process isn't running
    Open MyFile For Append As #1
    Write #1, Now & " : Process already stopped."
    Close #1
Else
    'The process is running
    Open MyFile For Append As #1
    For Each objProcess In objList
        'Terminate the process and all of its threads.
        intError = objProcess.Terminate
        If intError <> 0 Then
            'Return value is 0 for success. Any other number is an error.
            Write #1, Now & " : Unable to terminate process.  intError = " & intError
        Else
            Write #1, Now & " : Process terminated ok."
        End If
    Next
    Close #1
    Set objProcess = Nothing
End If

Set objWMIcimv2 = Nothing
Set objList = Nothing

End Sub

I was now wondering if it would be possible to make it so in the active sheet i could set 2 cells for "scheduling" the times that the program opens or closes - as it is the code opens the program at 12midnight then closes it at 4pm. (between 4pm and midnight the program will be shut if opened)

By allowing these times to be entered into cells it would mean i could set anytime for instance open at midnight close at 1am or open at 6pm close at 3am etc etc

Any help would be great,

In advance thanks a heap for your time,

Titus

ps if this isnt explained very well just let me know and i will do my best to re explain

 

[Cbrine]

Titus,
This code seems to control execution time for the program. So, if the current time is less then 4pm(Meaning Hours 1-16 Military time) then the program is started, otherwise the process is ended. You would need to change this structure, since it will always start at one, and you want this to be a varilable time. Crossing the Midnight threshold is going to be a problem, but as long as you keep the time ranges within the same day, a simple revisions should work.

If Hour(Now) < 16 Then
StartMyProcess (MyProcess)
Else
StopMyProcess (MyProcess)
End If

If Hour(now) < sheets("Mysheet").range("A1") and Hour(now) < Sheets("Mysheet").range("A2") then
    StartMyProcess (MyProcess) 
Else 
    StopMyProcess (MyProcess) 
End If

You will need to update Mysheet and the range reference to yours, and you will still need to use military hours.

These are OK.
a1= 4
a2=16

a1=21
a2=23

These are not
A1=16
A2=4

A1=23
A1= 1

HTH

Cal

 

[Andrew Fergus]

Hi Tim

Following on from Cal, you can get this to work where the start time is after the stop time by using the following code. This also reverts back to the old way of starting at midnight and stopping at 4pm if you leave out the times. Replace the entire code in the MyTimer sub with this :

Sub MyTimer()

Dim intStHour As Integer, _
    intEdHour As Integer, _
    intStMin As Integer, _
    intEdMin As Integer

When = Now + Sec / 60 / 60 / 24

Application.OnTime When, "MyTimer"

If Sheets("Sheet1").Range("A1") = "" Or Sheets("Sheet1").Range("A2") = "" Then

    'Original Code
    If Hour(Now) < 16 Then
        StartMyProcess (MyProcess)
    Else
        StopMyProcess (MyProcess)
    End If

Else
    
    'Get the start and end times from the spreadsheet (assumed Sheet 1 and cells A1/A2)
    intStHour = Hour(Hour(Sheets("Sheet1").Range("A1")))
    intEdHour = Hour(Sheets("Sheet1").Range("A2"))
    intStMin = Minute(Sheets("Sheet1").Range("A1"))
    intEdMin = Minute(Sheets("Sheet1").Range("A2"))

    If intStHour < intEdHour Then
        'Start time before end time
        If Hour(Now()) < intStHour Or Hour(Now()) > intEdHour Then
            StopMyProcess (MyProcess)
        ElseIf intStHour = Hour(Now()) And Minute(Now()) < intStMin Then
            StopMyProcess (MyProcess)
        ElseIf intEdHour = Hour(Now()) And Minute(Now()) >= intEdMin Then
            StopMyProcess (MyProcess)
        Else
            StartMyProcess (MyProcess)
        End If
    ElseIf intStHour > intEdHour Then
        'End time before start time
        If Hour(Now()) < intEdHour Or Hour(Now()) > intStHour Then
            StartMyProcess (MyProcess)
        ElseIf Hour(Now()) = intEdHour And Minute(Now()) < intEdMin Then
            StartMyProcess (MyProcess)
        ElseIf Hour(Now()) = intStHour And Minute(Now()) >= intStMin Then
            StartMyProcess (MyProcess)
        Else
            StopMyProcess (MyProcess)
        End If
    Else
        'Same starting hour
        If intStMin < intEdMin Then
            'Start time before end time
            If Hour(Now()) < intStHour Or Hour(Now()) > intEdHour Then
                StopMyProcess (MyProcess)
            ElseIf intStHour = Hour(Now()) And Minute(Now()) < intStMin Then
                StopMyProcess (MyProcess)
            ElseIf intEdHour = Hour(Now()) And Minute(Now()) >= intEdMin Then
                StopMyProcess (MyProcess)
            Else
                StartMyProcess (MyProcess)
            End If
        Else
            'End time before start time
            If Hour(Now()) < intEdHour Or Hour(Now()) > intStHour Then
                StartMyProcess (MyProcess)
            ElseIf Hour(Now()) = intEdHour And Minute(Now()) < intEdMin Then
                StartMyProcess (MyProcess)
            ElseIf Hour(Now()) = intStHour And Minute(Now()) >= intStMin Then
                StartMyProcess (MyProcess)
            Else
                StopMyProcess (MyProcess)
            End If
        End If
    End If
End If

End Sub

This assumes the sheet name is 'Sheet1' and the start time is in cell A1 and the stop time is in cell A2. Adjust the code accordingly if you are using qa different sheet or cells.

HTH, Andrew

P.S. After your original thread I developed a small VB utility to do exactly this without the need to have Excel open. It is free to download from here : http://www.bizequip.co.nz/shares.htm#7

P.P.S. This could probably be simplified greatly using Now()<>A1 etc but it was cribbed from my VB6 code verbatim where the time was not stored as a time, but as a string.

 

[TiTuS]

Hi Andrew,

So would the utility you developed also implement the code you just posted? allowing any start and stop time...?

Also what program did you use to create such a utility cause i was thinking it would be awesome to do the same but wasnt sure what prog i would use.

Thanks a heap,

Tim

 

[Andrew Fergus]

Hi Tim

Some much simpler code for your spreadsheet :

Sub MyTimer()

Dim dtStart As Date, _
    dtEnd As Date, _
    dtNow As Date
    
When = Now + Sec / 60 / 60 / 24

Application.OnTime When, "MyTimer"

If Sheets("Sheet1").Range("A1") = "" Or Sheets("Sheet1").Range("A2") = "" Then

    'Original Code
    If Hour(Now) < 16 Then
        StartMyProcess (MyProcess)
    Else
        StopMyProcess (MyProcess)
    End If

Else
    
    'Get the start and end times from the spreadsheet (assumed Sheet 1 and cells A1/A2)
    dtNow = Format(Now(), "hh:nn:ss")
    dtStart = Format(Sheets("Sheet1").Range("A1"), "hh:nn:ss")
    dtEnd = Format(Sheets("Sheet1").Range("A2"), "hh:nn:ss")

    If dtStart < dtEnd Then
        'Start time before end time
        If dtNow >= dtStart And dtNow < dtEnd Then
            StartMyProcess (MyProcess)
        Else
            StopMyProcess (MyProcess)
        End If
    ElseIf dtStart > dtEnd Then
        'End time before start time
        If dtNow >= dtEnd And dtNow < dtStart Then
            StopMyProcess (MyProcess)
        Else
            StartMyProcess (MyProcess)
        End If
    End If
End If

End Sub

That utility I linked to is a standalone utility that does exactly what your spreadsheet is trying to do - ie control the start and stop time for a programme using any time (to the nearest 5 minutes). I used Visual Basic 6 to make that utility - unfortunately VB6 isn't free.

Andrew