Calling or Exiting a prog on time

[TiTuS]

Hi i was just wondering if it would be possible to have excel open or close a program on my computer due to the time on my comp...

This is what i need to do.

Between the hours of 4pm and 12Am (midnight) i want a certain program to stay closed so i would want excel to check maybe every 30mins to try shut down that prog and if it cant find it to shut down then ignore the error. But on the other hand from 12AM till 4pm i want the program to be open... with this side of the equation it would only need to be called at 12 Am to open because at any other stage i could open the prog manually its just so it can pull some data in the middle of the night when im not around.

If anyone could give any ideas on how this could be done it would be really appreciated!

In advance thanks a heap for your time and help,

Titus,

P.s this isnt an urgant request just a application of excel that could make life a bit simplar

 

[Andrew Fergus]

Hi
Can you post your full code? The log indicates that it was starting the process every 20 seconds - it should have been something like "already started".
Andrew

 

[TiTuS]

This Workbook

Option Explicit

Private Sub Workbook_Open()

    Sec = 10 'i.e. every 30 minutes
    Run "MyTimer"

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Run "StopMyTimer"

End Sub

Module 1

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 = "C:\Program Files\Azureus\Azureus.exe"
'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(MyProcess, vbHide)
    Open MyFile For Append As #1
    Write #1, Now & " : Process started ok."
    Close #1
    'MsgBox "opened" 'Used for testing purposes only
Else
    'The process has already been started
    DoEvents
    'MsgBox "already open" 'Used for testing purposes only
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
    DoEvents
    'MsgBox "already closed" 'Used for testing purposes only
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."
            'MsgBox "error" 'Used for testing purposes only
        Else
            Write #1, Now & " : Process terminated ok."
            'MsgBox "closed" 'Used for testing purposes only
        End If
    Next
    Close #1
    Set objProcess = Nothing
End If

Set objWMIcimv2 = Nothing
Set objList = Nothing

End Sub

 

[Andrew Fergus]

Hi TiTuS

It is the file path / directory that is preventing the code from stopping the process. I have made a few minor tweaks so try this code instead :

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

And if you push your clock forward you can accelerate the test (e.g. from 10:56 am to 10:56pm) - it doesn't however work the other way.

HTH, Andrew

 

[TiTuS]

Hey Andrew,

Ive just tested out your update and it worked perfectly! Thankyou so so much for your help!

Titus