Solved Looking for Restart on Crash monitoring software

January 23, 2016 at 07:07:10
Specs: Windows 7, 16GB
looking for a solution to restarting a program that crashes but has the 'close program' windows box on screen.

using a prog at moment called restart on crash.
while it works when the prog crashes it does not work if the close program box is on screen.

message edited by indigian


See More: Looking for Restart on Crash monitoring software

Report •

✔ Best Answer
January 28, 2016 at 02:02:13
I have emailed you the file.

Below is the code which is split into 1 module and 1 worksheet. I have also included details of the layout of the worksheet.

One thing i thought of yesterday was, when the close window dialog is terminated, it doesnt always mean that the software that caused the close window to appear will also be terminated too. Therefore what i will do in this case, is update the code so you can specify more than one process to terminate, this can be the close window dialog and the application that you are running (iv made the assumption that when the close dialog window appears, it is because of your software). So in B2 you can have something like

Close Program.exe,MySoftware.exe.

Sheet1 code

Dim StopTimer           As Boolean
Dim SchdTime            As Date
Dim Etime               As Date
Const OneSec            As Date = 1 / 86400#

Dim WindowCaption As String
Dim ProcessName As String
Dim AppPath As String

Private Sub ResetBtn_Click()
    StopTimer = True
    Etime = 0
End Sub

Private Sub StartBtn_Click()
   StopTimer = False
   SchdTime = Now()
   Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub

Private Sub StopBtn_Click()
    StopTimer = True
    Beep
End Sub

Sub NextTick()
   If StopTimer Then
      'Don't reschedule update
   Else
       
    AppActivate Application.Caption
    
    WindowCaption = Sheet1.Range("B1")
    
    If ReturnResult = WindowCaption Then
        
        Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Window " & "'" & WindowCaption & "'" & " found at: " & Now() & vbCrLf
        
        TerminateProc

    End If

    SchdTime = SchdTime + OneSec
    Application.OnTime SchdTime, "Sheet1.NextTick"
    Etime = Etime + OneSec
           
   End If
End Sub

Private Sub CommandButton1_Click()
    StartBtn_Click
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring started at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Monitoring"
End Sub

Private Sub CommandButton2_Click()
    StopBtn_Click
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring stopped at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Stopped and idle"
End Sub

Private Sub CommandButton3_Click()
    ResetBtn_Click
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring reset at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Timer Reset"
End Sub

Public Function ReturnResult() As String

    Dim FindWhat As String
    
    FindWhat = Sheet1.Range("B1").Text
    ReturnResult = (GetCaption$(DLHFindWin&(Application.hwnd, FindWhat, False)))
    
End Function

Sub TerminateProc()

Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object

Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")

For Each oProc In cProc
    
    ProcessName = Sheet1.Range("B2")
    
    If oProc.Name = ProcessName Then
        
        Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Process " & "'" & ProcessName & "'" & " terminated at: " & Now() & vbCrLf
        
        errReturnCode = oProc.Terminate()
    End If
Next

    StartProgram

End Sub

Sub StartProgram()
    
    AppPath = Sheet1.Range("B3")
    
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf & vbCrLf
    
    Shell AppPath
    
End Sub


Module code

Option Explicit

Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function GetNextWindow Lib "user32" _
Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) _
As Long

Public Function GetCaption(lhWnd As Long) As String

Dim sA As String, lLen As Long

   lLen& = GetWindowTextLength(lhWnd&)

      sA$ = String(lLen&, 0&)

   Call GetWindowText(lhWnd&, sA$, lLen& + 1)
   GetCaption$ = sA$

End Function

Public Function DLHFindWin(frm As Long, WinTitle As String, _
CaseSensitive As Boolean) As Long

Dim lhWnd As Long, sA As String

   lhWnd& = frm

Do

   DoEvents
      If lhWnd& = 0 Then Exit Do
         If CaseSensitive = False Then
             sA$ = LCase$(GetCaption(lhWnd&))
             WinTitle$ = LCase$(WinTitle$)
         Else
             sA$ = GetCaption(lhWnd&)
         End If

       If InStr(sA$, WinTitle$) Then
          DLHFindWin& = lhWnd&
          Exit Do
       Else
         DLHFindWin& = 0
       End If

       lhWnd& = GetNextWindow(lhWnd&, 2)

Loop

End Function

Add three buttons
CommandButton1 - This will be Start
CommandButton2 - this will be Stop
CommandButton3 - This will be Reset

Select ranges A5 to F18
Merge this range
align left
align top
change font to red (or whatever you like)
Name this range 'Txtinfo'

Select range B20 to F20
name this range 'txtStatus'

all other details on the sheet can be added from the jpg image in #10.

See how it works and let us know of the results hopefully with a bit of tweaking we can possibly have a solution for you.

message edited by AlwaysWillingToLearn



#1
January 23, 2016 at 07:10:46
That's far to broad to try and solve. Please let us know what program you mean and describe exactly what happens.

EDIT:
Thanks for the additions.

Always pop back and let us know the outcome - thanks

message edited by Derek


Report •

#2
January 23, 2016 at 09:26:10
Usually it is best to let the program close and restart it from scratch. This lets all code to be loaded fresh without errors.
If your restart program starts it if it closes completely then you just need something to cause the close program box to auto complete. I do not know if this needs to be accomplished via code or a registry tweak to the close program pop up. If this would happen on its own then I assume that your restart should then work then in this case.

You have to be a little bit crazy to keep you from going insane.


Report •

#3
January 23, 2016 at 11:56:56
Not sure that I can add any more but let us have a link to the download please, or is it this one:
http://w-shadow.com/blog/2009/03/04...

Always pop back and let us know the outcome - thanks


Report •

Related Solutions

#4
January 23, 2016 at 14:49:23
"while it works when the prog crashes it does not work if the close program box is on screen"
Go to Task Manager > Processes, click on > restart on crash, click on > End task.

Report •

#5
January 23, 2016 at 16:10:23
From how i am reading it he has a program that needs to be running. He uses a crash restart program to restart the program automatically but this does not work if the close program box pops up instead of the program completely closing. If I am right he needs the close program box to allow the program to completely close unattended so the crash program can relaunch the main program again. He might need a script to automatically activate the OK the close program dialog box that Windows pops up on crash so that the restart program can do its job unattended. I may be wrong but this is how I read it.

You have to be a little bit crazy to keep you from going insane.


Report •

#6
January 23, 2016 at 16:31:18
Yep. Assuming there is only one program that needs restarting it depends on whether the crash monitoring program can be arranged to send a trigger to start the OK script at the right time - tricky. Closing the crashed program would be fairly easy - AutoHotKey could do it.

Initially I thought this question looking for a fix for the crash monitoring program, in the same way as we might fix any failing program.

Always pop back and let us know the outcome - thanks

message edited by Derek


Report •

#7
January 25, 2016 at 00:41:34
Yes Fingers/Derek that's it and yes Derek that is the program I'm using.


message edited by indigian


Report •

#8
January 25, 2016 at 07:19:13
I doubt this can be done without rewriting the program, unless you can see some way of picking up that trigger. Here are some others which you could try:
https://www.raymond.cc/blog/keep-ap...

Always pop back and let us know the outcome - thanks

message edited by Derek


Report •

#9
January 26, 2016 at 03:19:50
I have come up with a VBA Excel solution will this be acceptable? basically what it does is:

1) Monitors for a window to appear by its caption name - assuming its 'Close Program' you can define this in a worksheet cell

2) Closes the 'Close Program' Window - need you to test this as i cannot replicate - although i can close other windows such as Outlook, Notepad

3) Launches a program of your choosing, again this can be defined within a cell.

This solution is not without its flaws, in order for it to work it needs Excel to have focus, so the codes continously sets focus to Excel, which means that if you are interacting with other applications, it will take focus from them every few seconds.. Annoying but if you are leaving the machine alone then i guess its ok.

Let me know if this is acceptable and i will tidy up the code. Its not perfect but works.


Report •

#10
January 26, 2016 at 06:23:08
If anyone is interested i have made the neccessary changes to the code and it seems to be working pretty well, when i am looking for Word or Notepad, i am unable to replicate the 'Close Program' window but i am sure it can be achieved.

Below is a screenshot of how the Excel sheet is layed out. I can email the Excel to anyone if they PM me their email address, or post the code, but you'll have to then replicate the sheet layout otherwise there will be errors...

Range("B1") has the window caption that needs to be detected
Range("B2") has the name of the process that needs to be closed
Range("B3") has the name of the application that needs to be loaded

In my case whenever Word is opened its Window caption is 'Document1 - Microsoft Word' when this is detected, the process 'WINWORD.EXE' in terminated and the application 'SnippingTool.exe' is started.

so in the case of the OP:

B1 will be the caption of the 'Close Program' window

B2 will be the process associated with the 'Close program' windows. This can be found via task manager once the window is displayed

B3 will be the name of the software that crashed and needs restarting.

I have also included a output window where information of when

Monitoring started
Crash was detected
Crash was terminated
Application was launched

Screenshot

http://s2.postimg.org/7ui5pf1dl/Mon...

message edited by AlwaysWillingToLearn


Report •

#11
January 26, 2016 at 09:37:35
Re #9 & 10 - Nice one. Looks like a good base for indigian to jump off from

Always pop back and let us know the outcome - thanks


Report •

#12
January 27, 2016 at 00:43:13
That sounds great :)

I don't have office installed :(

Can I just install excel on it's own?
PC is a server machine running win7,for now.
The prog that occasionally hangs/crashes is a log in server.

Willing to test,many thanks


Report •

#13
January 27, 2016 at 01:26:25
Office suites, all Freeware.
http://www.softpedia.com/catList/11...

Report •

#14
January 27, 2016 at 03:58:33
indigian,

install office, I don't think you can install Excel by itself, but others may know something different.. Also not sure if the VBA code will be translated correctly on the free version of office. I honestly have no idea.

Once you are ready send me a PM with your email address and I will forward the workbook to you, I will also paste the code and design details here just for completeness, I am not in the office today so will post the code tomorrow.


Report •

#15
January 27, 2016 at 08:18:50
Kingsoft listed in #13 is said to be very similar to MS Office and highly compatible. If you install the whole freebie it only installs three packages (inc Word and Excel equivalents). You can also download individuals - here is the Excel equivalent:
http://www.kingsoftstore.com/spread...

I found Open Office (now Apache) very slow, particularly on limited machines.

Always pop back and let us know the outcome - thanks

message edited by Derek


Report •

#16
January 28, 2016 at 02:02:13
✔ Best Answer
I have emailed you the file.

Below is the code which is split into 1 module and 1 worksheet. I have also included details of the layout of the worksheet.

One thing i thought of yesterday was, when the close window dialog is terminated, it doesnt always mean that the software that caused the close window to appear will also be terminated too. Therefore what i will do in this case, is update the code so you can specify more than one process to terminate, this can be the close window dialog and the application that you are running (iv made the assumption that when the close dialog window appears, it is because of your software). So in B2 you can have something like

Close Program.exe,MySoftware.exe.

Sheet1 code

Dim StopTimer           As Boolean
Dim SchdTime            As Date
Dim Etime               As Date
Const OneSec            As Date = 1 / 86400#

Dim WindowCaption As String
Dim ProcessName As String
Dim AppPath As String

Private Sub ResetBtn_Click()
    StopTimer = True
    Etime = 0
End Sub

Private Sub StartBtn_Click()
   StopTimer = False
   SchdTime = Now()
   Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub

Private Sub StopBtn_Click()
    StopTimer = True
    Beep
End Sub

Sub NextTick()
   If StopTimer Then
      'Don't reschedule update
   Else
       
    AppActivate Application.Caption
    
    WindowCaption = Sheet1.Range("B1")
    
    If ReturnResult = WindowCaption Then
        
        Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Window " & "'" & WindowCaption & "'" & " found at: " & Now() & vbCrLf
        
        TerminateProc

    End If

    SchdTime = SchdTime + OneSec
    Application.OnTime SchdTime, "Sheet1.NextTick"
    Etime = Etime + OneSec
           
   End If
End Sub

Private Sub CommandButton1_Click()
    StartBtn_Click
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring started at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Monitoring"
End Sub

Private Sub CommandButton2_Click()
    StopBtn_Click
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring stopped at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Stopped and idle"
End Sub

Private Sub CommandButton3_Click()
    ResetBtn_Click
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring reset at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Timer Reset"
End Sub

Public Function ReturnResult() As String

    Dim FindWhat As String
    
    FindWhat = Sheet1.Range("B1").Text
    ReturnResult = (GetCaption$(DLHFindWin&(Application.hwnd, FindWhat, False)))
    
End Function

Sub TerminateProc()

Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object

Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")

For Each oProc In cProc
    
    ProcessName = Sheet1.Range("B2")
    
    If oProc.Name = ProcessName Then
        
        Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Process " & "'" & ProcessName & "'" & " terminated at: " & Now() & vbCrLf
        
        errReturnCode = oProc.Terminate()
    End If
Next

    StartProgram

End Sub

Sub StartProgram()
    
    AppPath = Sheet1.Range("B3")
    
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf & vbCrLf
    
    Shell AppPath
    
End Sub


Module code

Option Explicit

Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function GetNextWindow Lib "user32" _
Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) _
As Long

Public Function GetCaption(lhWnd As Long) As String

Dim sA As String, lLen As Long

   lLen& = GetWindowTextLength(lhWnd&)

      sA$ = String(lLen&, 0&)

   Call GetWindowText(lhWnd&, sA$, lLen& + 1)
   GetCaption$ = sA$

End Function

Public Function DLHFindWin(frm As Long, WinTitle As String, _
CaseSensitive As Boolean) As Long

Dim lhWnd As Long, sA As String

   lhWnd& = frm

Do

   DoEvents
      If lhWnd& = 0 Then Exit Do
         If CaseSensitive = False Then
             sA$ = LCase$(GetCaption(lhWnd&))
             WinTitle$ = LCase$(WinTitle$)
         Else
             sA$ = GetCaption(lhWnd&)
         End If

       If InStr(sA$, WinTitle$) Then
          DLHFindWin& = lhWnd&
          Exit Do
       Else
         DLHFindWin& = 0
       End If

       lhWnd& = GetNextWindow(lhWnd&, 2)

Loop

End Function

Add three buttons
CommandButton1 - This will be Start
CommandButton2 - this will be Stop
CommandButton3 - This will be Reset

Select ranges A5 to F18
Merge this range
align left
align top
change font to red (or whatever you like)
Name this range 'Txtinfo'

Select range B20 to F20
name this range 'txtStatus'

all other details on the sheet can be added from the jpg image in #10.

See how it works and let us know of the results hopefully with a bit of tweaking we can possibly have a solution for you.

message edited by AlwaysWillingToLearn


Report •

#17
January 28, 2016 at 04:48:29
Thank you kindly.
As soon as I have got needed progs installed to try I will let you know

Report •

#18
January 28, 2016 at 06:02:06
ok,

i have made some other changes to the program which may be useful if the first one fails for whatever reason. In the new version:

1) You can tell the software to look for any applications title\caption that is sufixed with (Not Responding). So for example i was able to make MS Word unresponsive with a never ending loop, its caption then changed to

Document1 - Microsoft Word (Not Responding)

using this method it can not only look for the 'Close Program' window but can also be used to check if your application has stopped responding, bearing in mind that just because it has stopped responding doesnt always mean that its crashed!

2) You can now specify more than one process to kill when a window caption is detected

3) i have put a 5 second pause betwen the termination of all processes and the loading of your application, just to allow everything to close

Anyways, we can check this out once you come back with results from the first code.


Report •

#19
February 2, 2016 at 05:01:16
Ok I'm ready to test.

Opening the document I find

Windows Caption (I will fill this in when it hangs next)
Process Name (This is the process that hangs,the one I want to restart?)
Software Path (This is the location of the above?)

The 'program/process' is started by a bat file which has the db details in it.
roc was able to start the program with these details in a command line

Can the 'Software Path' point to the bat file?
This is only looking for the 'hung' close program box yes,not that the process has closed?


Report •

#20
February 2, 2016 at 05:16:57
Window Caption is the caption of the 'Close Program' window

ProcessName is the name of the process that has hung, i have updated the code and sent you the file so you can have more than one process name seperated by a comma, such as 'CloseProgram.exe','MyApplication.exe'

SoftwarePath can indeed be a bat file but you may need to change the following

Shell AppPath

becomes

Shell AppPath, vbNormalFocus


Report •

#21
February 2, 2016 at 05:33:31
Shell AppPath

becomes

Shell AppPath, vbNormalFocus

Where and how to change this?

Thanks


Report •

#22
February 2, 2016 at 05:38:53
This is in the code, if you open Excel, hold Alt and then press F11 the VBE IDE will appear, you can then look or do a search for the following sub and change the line of code

Sub StartProgram()
    
    AppPath = Sheet1.Range("B3")
    
    Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf & vbCrLf
    
    Shell AppPath
    
End Sub

The last line before End Sub is what you need to change

message edited by AlwaysWillingToLearn


Report •

#23
February 2, 2016 at 05:56:46
Found and changed thanks :)

Just gotta wait for it too crash/hang now then get the info needed.


Report •

#24
February 4, 2016 at 08:24:48
Some kind of success.

I'm manually making tthe prog/app crash/hang by exiting wamp.
The close program box gets shut and it starts up the bat file.

Problem being is that it says it cannot find the exe that the bat file opens.
I think the problem is that it runs the bat file from a cmd window.
bat file and exe are in the same folder,if I remove the bat file and run it I get pretty much the same error.
The exe also needs wamp to be running or it won't start,well it does start but stops in about 2 seconds.

Also like you said it needs to be the main focus or it doesn't run.


Report •

#25
February 4, 2016 at 09:17:44
Ok so at least for now we are able to detect the close program window, close it and run the batch

I think in vba you have to run batch slightly differently to how i have done it, i have a plan and will update the code tomorrow.


Report •

#26
February 4, 2016 at 11:15:40
Thank you

I'm just trying a work around at moment by also running roc.
seems to work except the couldn't find program window remains.

Is there possibility to have a log file?
Just to know if and when it crashed.


Report •

#27
February 4, 2016 at 11:47:08
Just wondering if the code needs to

First run wamp then
Run the batch?

what i will do tomorrow is create a batch file that runs an application which will be in the same location as the batch, then write some vba code to run the batch which will launch an application.

My question therefore is, if i can write the vba that will run a batch and the batch run an application, will that be the concluding part for this software or are there other things you need? If possible can you bullet point everything you need as i tend tocl get confused very easily, also i can then code everything required.

Also the on screen log can be saved as a text file if that is what you are wanting? It details when the crash occured, when the monitoring began, when the process was terminated and your applcatin launched etc, time stamps are also present. If i save this as a text file to your desktop will that be ok?

message edited by AlwaysWillingToLearn


Report •

#28
February 4, 2016 at 14:25:33
wamp is always running,I just closed it for testing,it does not need any attention.

Basically I start the program with the bat file.
bat file is nothing special,it just has database,user and password info in it.
program then uses that info to read/write into the database.

your code does run the bat file and uses the info in it but it runs it through cmd so doesn't know or see where the program is?

When I used roc it monitored the program and restarted it fine but it didn't have the db info so it just stopped/crashed.
I then found out I could put the db info into the command parameter of roc and that works great.
only problem being the hang window as above

At the moment the work around seems to be doing ok.
it has crashed/hung around a dozen times but is still running :)
only there's a dozen boxes needed closing haha
________________________________________________________

"My question therefore is, if i can write the vba that will run a batch and the batch run an application, will that be the concluding part for this software or are there other things you need?"

yes that should do it.
desktop is fine unless it can be saved in the same place I run your file from?

message edited by indigian


Report •

#29
February 5, 2016 at 03:25:30
your code does run the bat file and uses the info in it but it runs it through cmd so doesn't know or see where the program is?

ok this is what is confusing me, if the batch file runs via my vba, and the batch file is able to launch your application using the info in it, i dont quite get what the issue is. Please bare in mind that although it may be obvious to you, i am not at your machine so need to know exactly what the problem is, what you think maybe causing it and perhaps how you think we can overcome it via code...

runs it through cmd so doesn't know or see where the program is

if the issue is merely hiding the cmd window, then that can be achieved by changing the line as per post #20 from

Shell AppPath, vbNormalFocus

to

Shell AppPath, vbHide

This will run your batch file without displaying the CMD window at all.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

to stop you having to run the entire program to test the launch of the batch file you can copy the following code into a new excel file and run it to run your batch, and see if it works.

I wrote a batch file to run an application called test.exe

@echo off
cls
Start %~dp0Test.exe
exit

the %~pd0 tells it that the applcation test.exe is in the same location at the batch file.


the VBA to run this is

Sub RunBatch()

Shell "C:\launcher.bat", vbHide

End Sub

This will call my batch file
the batch file will load hidden
and call the test.exe file

iv tested this and it works for me


as i am working remotely today i will update the code for the log on Monday

message edited by AlwaysWillingToLearn


Report •

#30
February 5, 2016 at 06:01:38
Please excuse my poor explaining,I'm just an experienced PC user.
All these codes and commands are a little over my head.

The window is not the problem.
Your vba runs my bat file but my bat file does not then open my program.
What I see on screen is a cmd window with the instruction to run/open my bat file and the db parameters.
Another window then pops up with 'windows cannot find said program',this being the program that the bat file runs.
A little experimentation suggests this is because my bat file is run from within a cmd window.
If I manually run my bat file through a cmd window I get the same error as your vba.

I experimented a bit more..........

If I manually run the program through a cmd window with the db info after the program name then it works.

So I have changed the 'software path' to point to the program with this info included instead of the bat file.

I think this might work but of course I have to wait for it to crash/hang again.......

So I think all that's needed now is the log file saving addition.

message edited by indigian


Report •

#31
February 8, 2016 at 02:19:57
here is the code for saving a log file with the same data that will appear on screen (sheet 1)

As i have a few different versions of this workbook, i am unsure of which version you are using, so will just post the code for saving the logfile, you can paste this into the workbook you are using, although you might need to modify one line.

Paste the following code at the botton of sheet 1 code window

1) Open Excel
2) Press and hold Alt and press F11
3) Select sheet 1 from the left hand side project explorer
4) Scroll to the bottom and paste this code

Private Sub UpdateLog()
    
    Dim LogFile As String
    LogFile = ThisWorkbook.Path
    LogFile = LogFile & "\Log.txt"
    
    Open LogFile For Output As #1
    Print #1, TxtInfo.Text & vbCrLf & vbCrLf
    Close #1
    
End Sub

This will save the logfile as 'Log.txt' in the same location as where you are running the workbook from.


You will now have to add one more line of code to call this routine. Within the same window look for

Sub StartProgram()

Just above 'End Sub' add the following line

UpdateLog

So Sub Start should look something like the below (obviously we've made some changes so it may vary now slightly)

Sub StartProgram()
    
    AppPath = Sheet1.Range("B3")
    
    'Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf & vbCrLf
    Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf & vbCrLf
    DoEvents
    Shell AppPath
        
    UpdateLog
    
End Sub

NOTE

One of the design changes i have made between the old version and the new is that, it has a text box (txtinfo) rather than a merged range Range("txtinfo"). This allows better control over how the log is presented on screen.

The new version also has some code changed which allows it to be more efficient but if the old works stick with it.

Depending on which workbook you are using you will have to modify one line of code in UpdateLog

Old workbook with merged range

Print #1, Sheet1.range("TxtInfo").Text & vbCrLf & vbCrLf

New workbook with textbox

Print #1, TxtInfo.Text & vbCrLf & vbCrLf

The easy way to check which one your are using is do a search in the code for

sheet1.range("txtinfo")

if you find this in the code and the line is

Not green (ie commented out)
and does not start with a '

Then you are using an older version

if you get stuck let us know.

message edited by AlwaysWillingToLearn


Report •

#32
February 10, 2016 at 05:54:20
Hi,

How is this code working for you? have you had a chance to test out the entire program?


Report •

#33
February 10, 2016 at 06:30:21
Not had a chance as yet.....

Report •

#34
February 11, 2016 at 02:43:40
Changes made,waiting on a crash/hang again.

Not sure which version I have?


Report •

#35
February 11, 2016 at 03:04:27
i am assuming you are using the first excel workbook i sent you so you will have the older version. If all else fails i will update the workbook with the code and send it to you.

Report •

#36
February 14, 2016 at 11:22:31
I think it worked but there was a visual basics windows box pop up saying 'object required' ?
there is a text log but it's empty.

Maybe I did the editing wrong?

message edited by indigian


Report •

#37
February 15, 2016 at 00:12:04
I was expecting that, i think you are using the older version so therefore you do not have the object "txtinfo" as a textbox. Let me update the workbook and i will send it to you via email.

Report •

#38
February 15, 2016 at 07:12:48
AlwaysWillingToLearn

I've been following this with interest. If you solve it, as looks likely, let us know the solution on here.

Thx

Always pop back and let us know the outcome - thanks


Report •

#39
February 15, 2016 at 07:21:22
Derek,

No worries, my intention was always to post the code here just for completeness, i have made several changes so wanted to avoid overloading the thread with multiple versions. The OP is currently using the first version i created - but i have made several itterations just for my own sakes and also because whilst testing and coding i thought of certain conditions where certain features may be neccessary. Hopefully Indigian is able to test the code soon and hopefully it works and is solved. I will then post the code here.


Report •

#40
February 15, 2016 at 09:12:48
Swapped to v3 now,just waiting on a crash.

Report •

#41
February 15, 2016 at 17:33:30
V3 works perfect.

Prog Crashed
Restarted by v3 and log written.
no other windows open.

Awesome work

Thank you


Report •

#42
February 16, 2016 at 00:09:05
Awesome glad it worked!!!!

i will post the code and structure later on today

If you can please mark as solved

Thanks,


Report •

#43
February 16, 2016 at 00:12:03
Fantastic work AlwaysWillingToLearn

Report •

#44
February 16, 2016 at 03:14:12
Thanks a lot JohnW,

This was quite a fun and interesting little application to write, im glad it worked for the OP.

Here is the code and structure

Sheet 1 code

Dim StopTimer           As Boolean
Dim SchdTime            As Date
Dim Etime               As Date
Const OneSec            As Date = 1 / 86400#

Dim WindowCaption As String
Dim ProcessName As String
Dim AppPath As String

Private Sub ResetBtn_Click()
    StopTimer = True
    Etime = 0
End Sub

Private Sub StartBtn_Click()
   StopTimer = False
   SchdTime = Now()

   Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub

Private Sub StopBtn_Click()
    StopTimer = True
    Beep
End Sub

Sub NextTick()
   If StopTimer Then
      'Don't reschedule update
   Else
       
    AppActivate Application.Caption
    Range("txtinfo").Select
    
    If Sheet1.Range("txtstatus").Text = "Monitoring" Then
        If Sheet1.Range("txtstatus").Font.Color = vbWhite Then
            Sheet1.Range("txtstatus").Font.Color = vbBlack
        Else
            If Sheet1.Range("txtstatus").Font.Color = vbBlack Then
                Sheet1.Range("txtstatus").Font.Color = vbWhite
            End If
        End If
    End If
    
    WindowCaption = Sheet1.Range("B1")
    
    If ReturnResult Like "*" & WindowCaption & "*" Then
        Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "******************************CRASH DETECTED*******************************" & vbCrLf
        Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "Window " & "'" & WindowCaption & "' " & "(" & ReturnResult & ")" & " found at: " & Now() & vbCrLf
        DoEvents

        SlipTerminationData

    End If
            
    SchdTime = SchdTime + OneSec
    Application.OnTime SchdTime, "Sheet1.NextTick"
    Etime = Etime + OneSec
           
   End If
End Sub

Private Sub CommandButton1_Click()
    
    For Each cell In Range("B1:B3")
        
        If cell.Text = Empty Then
            
            Dim ErrString As String
            ErrString = ErrString & cell.Address & " is empty" & vbCrLf
        
        End If
    
    Next cell
                
    If ErrString <> Empty Then
        MsgBox ErrString
        Exit Sub
    End If
    
    StartBtn_Click

    Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "Monitoring started at: " & Now() & vbCrLf & vbCrLf
    Sheet1.Range("txtstatus") = "Monitoring"
    DoEvents
End Sub

Private Sub CommandButton2_Click()
    StopBtn_Click

    Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "Monitoring stopped at: " & Now() & vbCrLf
    Sheet1.Range("txtstatus") = "Stopped and idle"
    
    Range("txtstatus").Font.Color = vbWhite
    
    DoEvents
End Sub

Private Sub CommandButton3_Click()
    ResetBtn_Click
   
    Sheet1.Range("txtstatus") = "Timer Reset"
    Sheet1.TxtInfo.Text = Empty
    
    Range("txtstatus").Font.Color = vbWhite
    
    DoEvents
End Sub

Public Function ReturnResult() As String

    Dim FindWhat As String
    
    FindWhat = Sheet1.Range("B1").Text
    ReturnResult = (GetCaption$(DLHFindWin&(Application.hwnd, FindWhat, False)))
End Function

Sub SlipTerminationData()
    Dim DataString
    
    ProcessName = Sheet1.Range("B2")
    DataString = Split(ProcessName, ",")
    
    For intCount = LBound(DataString) To UBound(DataString)
       
        TerminateProc Trim(DataString(intCount))
    
    Next intCount
    
    Application.Wait (Now + TimeValue("0:00:05"))
   
    StartProgram
        
End Sub

Sub TerminateProc(iProc As String)

Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object

Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    For Each oProc In cProc
       
        If oProc.Name = iProc Then

            errReturnCode = oProc.Terminate()
            
            Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "Process: " & "'" & iProc & "'" & " terminate at: " & Now() & vbCrLf
            DoEvents
        End If
        
    Next

End Sub

Sub StartProgram()
    
    AppPath = Sheet1.Range("B3")
    
    Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf
    Sheet1.TxtInfo.Text = Sheet1.TxtInfo.Text & "***************************MONITORING RESTARTED***************************" & vbCrLf & vbCrLf
    DoEvents
    Shell AppPath
        
    UpdateLog
    
End Sub

Private Sub TxtInfo_Change()
    
    TxtInfo.SelStart = Len(TxtInfo.Text)
    
End Sub

Private Sub UpdateLog()
    
    Dim LogFile As String
    LogFile = ThisWorkbook.Path
    LogFile = LogFile & "\Log.txt"
    
    Open LogFile For Output As #1
    Print #1, TxtInfo.Text & vbCrLf & vbCrLf
    Close #1
    
    CommandButton1_Click
End Sub


Module Code

Option Explicit

Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function GetNextWindow Lib "user32" _
Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) _
As Long

Public Function GetCaption(lhWnd As Long) As String

Dim sA As String, lLen As Long

   lLen& = GetWindowTextLength(lhWnd&)

      sA$ = String(lLen&, 0&)

   Call GetWindowText(lhWnd&, sA$, lLen& + 1)
   GetCaption$ = sA$

End Function

Public Function DLHFindWin(frm As Long, WinTitle As String, _
CaseSensitive As Boolean) As Long

Dim lhWnd As Long, sA As String

   lhWnd& = frm

Do

   DoEvents
      If lhWnd& = 0 Then Exit Do
         If CaseSensitive = False Then
             sA$ = LCase$(GetCaption(lhWnd&))
             WinTitle$ = LCase$(WinTitle$)
         Else
             sA$ = GetCaption(lhWnd&)
         End If

       If InStr(sA$, WinTitle$) Then
          DLHFindWin& = lhWnd&
          Exit Do
       Else
         DLHFindWin& = 0
       End If

       lhWnd& = GetNextWindow(lhWnd&, 2)

Loop

End Function


Sheet 1 Structure

http://postimg.org/image/n4j723bwp

          A                        B
1        Window Caption       User to fill
2        Process Name(s)      User to fill
3        Software Path        User to fill

The greyed out area is a textbox which i have named "txtinfo" This gets appended each time an event is triggered. This is also used to append a log file with will be saved to the same location where the workbook is located.

Info Sheet

http://postimg.org/image/rrp93uz9l

Updates from version 1

- In the caption name field (Column B) you can partially specify a window caption for example i previously used the caption "Not Responding" which meant that if your application was called "Mouse Trap" and it crashed, its caption would change to "Mouse Trap Not Responding" this way it will find all unresponsive windows. You can also have something like "Inbox" which should detect Outlooks window as its prefix with "inbox" when you are in your inbox. Anything will work as long as it partially exists in the windows caption...

- Process name(s) you can specify more than one process to terminate when the caption window is detected, you just have to seperate them with a comma, for example ProcA.exe,ProcB.exe,ProcC.exe. The code will then loop through and terminate all these processes

- Sofware Path will load the application (.exe, .bath, .vbs(untested)) once all processes have been terminated.

If anyone wants the workbook please send me a PM with your email add i'll be more than happy to send it to you.

message edited by AlwaysWillingToLearn


Report •

#45
February 16, 2016 at 08:07:31
AlwaysWillingToLearn

Good to see such a good result after all your efforts.

Always pop back and let us know the outcome - thanks


Report •

#46
February 16, 2016 at 10:41:56
Thanks Derek,

Iv learnt a lot from all the users on this site so im glad i could do something to help too

message edited by AlwaysWillingToLearn


Report •

#47
February 16, 2016 at 15:31:16
Update

I found a 'bug'? in V3,that isn't in V1........

Basically this program allows servers to be seen when your in a certain game amongst otherthings.

V1 the 'Live Server' list is constant,it lists how many servers are present.
V3 the 'Live Server' list is empty but if you keep refreshing the list the servers appear randomly 1 at a time,so there's 1 or none in the list.

V3 restarts the crash/hang perfect otherwise,I was present and correct for a few crash/hang/restarts live.

Retesting V1 now,which is how I know the 'Live Server' list is constant.

Could it be because it's writing to the log file in the same folder?
I'm keeping yours in the same folder as the program.
(I'll test and get back to ya)
No

V1 once start has been clicked the pointer remains the pointer
V3 once start has been clicked the pointer goes to the 'thinking' circle
(but only when the pointer is inside excel window)

V3 seemed a bit hungry whereby it would just steal focus sometimes.

If V1 works fine but without log then I'm ok with that.

message edited by indigian


Report •

#48
February 17, 2016 at 00:18:53
Can you explain what the 'Live server' list is and how that is relevant to this application, i dont quite understand that. what is the relationship between this application and the live server list?

Could it be because it's writing to the log file in the same folder?
I'm keeping yours in the same folder as the program.
(I'll test and get back to ya)
No

What do you mean by No? what is that in relation to?

iv just tested both V1 and V3 the pointer (cursor) on my machine(s) stay as the arrow, the circular egg timer doesnt appear. There is not much difference between 1 and 3 apart from the fact you can specify more than one process to kill, which does have a for loop within it but shouldnt really cause an issue as its only triggered when the caption window is detected.

I am interested in this server list to understand what you are doing and how the code is working with that list....


V3 seemed a bit hungry whereby it would just steal focus sometimes.

If you look back at #9 i did mention that sometimes focus would be stolen from other applications as Excel will need focus in order to be able to detect open windows. this is the same for V1 there is no code difference between the two for gaining focus.

If you can explain in more detail what is happening, i prefer bullet points, we can try to iron out the remaining bugs


Report •

#49
February 17, 2016 at 01:35:17
Live server list looks like this.......(Not my pic)
http://air-war.org/image_server_lis...

The prog that crash/hangs is a login server software that tracks stats etc of players on these servers.
It writes all this info into a database.

When the prog crashes people cannot even log into the game so 'lists' are irrelevant.
V1 looks like the pic but in V3 the list is empty.
There are 2 'lists' within the game,the pic above shows WAN & LAN servers.
You can choose to only see LAN and this is fine with V3 but WAN/LAN is not.

I moved your code into a different location and ran it from there but list was still empty,hence the No.

I'm not sure why V3 interferes with the list but V1 does not.
I've tested and it's repeatable.

I understand about the 'focus' point but V3 was overly aggressive about it,far more than V1,it may be the logging part?

V3.1 seems like it doesn't start?
I'm testing it now but usually when your code doesn't have focus the excel box on the taskbar flashes green,it isn't with V3.1.
Also there's no 'text' flashing up saying it's started.

Would be happy to let you teamviewer in to both PC's to see what I mean if that would help.

message edited by indigian


Report •

#50
February 17, 2016 at 03:58:54
Iv updated v1 with the log saving code if that was all that v1 was missing then hopefully that will work.. please check your email

However i would like to understand why v3 is not working correctly, iv sent you an email with some debugging queries let see what we find...


EDIT
the issue seems to stem from my move from one IT environment to another, for some reason many of my users are complaining that macros have stopped working - not sure what the issue is yet but i think it may be with the "Microsoft Forms" library, im working on finding the cause but swapping the ActiveX button controls for the Form button control seems to resolve many of the issues........

message edited by AlwaysWillingToLearn


Report •

#51
March 2, 2016 at 01:40:36
This is the one that works if anyone is interested...........

Dim StopTimer As Boolean
Dim SchdTime As Date
Dim Etime As Date
Const OneSec As Date = 1 / 86400#

Dim WindowCaption As String
Dim ProcessName As String
Dim AppPath As String

Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
' Sheet2.Range("B3").Value = "00:00:00"
End Sub

Private Sub StartBtn_Click()
StopTimer = False
SchdTime = Now()
' Sheet2.Range("B3").Value = Format(Etime, "hh:mm:ss")
Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub

Private Sub StopBtn_Click()
StopTimer = True
Beep
End Sub

Sub NextTick()
If StopTimer Then
'Don't reschedule update
Else

AppActivate Application.Caption

WindowCaption = Sheet1.Range("B1")

If ReturnResult = WindowCaption Then
Sheet1.Range("TxtInfo") = Sheet1.Range("TxtInfo") & "******************************CRASH DETECTED*******************************" & vbCrLf
Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Window " & "'" & WindowCaption & "'" & " found at: " & Now() & vbCrLf

TerminateProc

End If

' Sheet2.Range("B3").Value = Format(Etime, "hh:mm:ss")
SchdTime = SchdTime + OneSec
Application.OnTime SchdTime, "Sheet1.NextTick"
Etime = Etime + OneSec

End If
End Sub

Private Sub CommandButton1_Click()
StartBtn_Click
Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring started at: " & Now() & vbCrLf & vbCrLf
Sheet1.Range("txtstatus") = "Monitoring"
End Sub

Private Sub CommandButton2_Click()
StopBtn_Click
Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Monitoring stopped at: " & Now() & vbCrLf
Sheet1.Range("txtstatus") = "Stopped and idle"
End Sub

Private Sub CommandButton3_Click()
ResetBtn_Click
Sheet1.Range("txtinfo").Value = Empty
Sheet1.Range("txtstatus") = "Timer Reset"
End Sub

Public Function ReturnResult() As String

Dim FindWhat As String

FindWhat = Sheet1.Range("B1").Text
ReturnResult = (GetCaption$(DLHFindWin&(Application.hwnd, FindWhat, False)))

End Function

Sub TerminateProc()

Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object

Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")

For Each oProc In cProc

'Rename EXCEL.EXE in the line below with the process that you need to Terminate.
'NOTE: It is 'case sensitive

ProcessName = Sheet1.Range("B2")

If oProc.Name = ProcessName Then

Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Process " & "'" & ProcessName & "'" & " terminated at: " & Now() & vbCrLf

errReturnCode = oProc.Terminate()
End If
Next

StartProgram

End Sub

Sub StartProgram()

AppPath = Sheet1.Range("B3")

Sheet1.Range("txtinfo") = Sheet1.Range("txtinfo") & "Application " & "'" & AppPath & "'" & " started at: " & Now() & vbCrLf & vbCrLf
Sheet1.Range("txtInfo") = Sheet1.Range("txtInfo") & "***************************MONITORING RESTARTED***************************" & vbCrLf & vbCrLf

Shell AppPath

UpdateLog

End Sub

Private Sub UpdateLog()

Dim LogFile As String
LogFile = ThisWorkbook.Path
LogFile = LogFile & "\Log.txt"

Open LogFile For Output As #1
Print #1, Sheet1.Range("TxtInfo").Text & vbCrLf & vbCrLf
Close #1

CommandButton1_Click
End Sub


Report •

#52
March 2, 2016 at 02:48:14
Great! thanks for letting us know, just to clarify this is version 1.0.

Report •

#53
July 28, 2016 at 08:41:41
Just found out the version I'm using is actually making a log :)

Report •

#54
July 29, 2016 at 01:07:59
Is that the 3.0 version? either way how is the software working for you?

Report •

#55
August 2, 2016 at 10:56:34
Not sure which version tbh but it's working great.
As long as it has the focus it does the job.

I can email this version back to you or copy paste into another reply?


Report •

#56
August 4, 2016 at 07:44:08
Hi,

Yes that would be great thanks :)


Report •

Ask Question