Automatically Reopening Excel After Closing (Loop)

[Hubbert2992]

Hi there chaps,

I am having a bit of a hiccup.

The problem is that I have "borrowed" some code from different sources and had a play with it.
Upon opening the workbook should run the "KickCatcher" macro. - (This bit is fine)
Then the "KickCatcher" macro runs and refreshes until an integer is entered into ".dat" file.

However, if there is another workbook also open at the same time as this workbook. Then the macro loops and re-opens the workbook which has just been closed.

If the workbook is opened on its own then it works fine.

Any help would be greatly appreciated.

This code goes into "ThisWorkbook":

Private Sub Workbook_Open()
KickCatcher
End Sub


This code is entered into a Module:

Option Explicit

Private Enum abBootType
'To use these, add. Example boot persistant with no warning = 5
BootNo = 0
BootOnce = 1
BootPersistant = 2
BootYes = 3
noWarning = 4
End Enum

Public Sub KickCatcher()
Dim strBootFile As String
Dim blnSaveChanges As Boolean
Dim eBootType As abBootType

If ThisWorkbook.ReadOnly Then Exit Sub
DoEvents

'Get boot file name in different folder:
strBootFile = "Enter directory here"

If Len(Dir(strBootFile)) > 0 Then
eBootType = Val(GetFileText(strBootFile))
If (eBootType And BootYes) <> BootNo Then 'if there is an entry in the .dat file, then continue
If (eBootType And noWarning) <> noWarning Then
blnSaveChanges = MsgBox("The author of this document has booted you." & vbNewLine & vbNewLine & "Do you want to save your work?", vbQuestion + vbYesNo + vbDefaultButton1, "Administrative Action") = vbYes
End If
If (eBootType And BootOnce) Then
Kill strBootFile
CreateEmptyFile strBootFile
End If
'Exit Sub
ThisWorkbook.Close blnSaveChanges
Else
Application.OnTime DateAdd("s", 1, Now), "KickCatcher"
End If
End If
End Sub

Private Function GetFileText(ByVal path As String) As String
Dim lngFileNum As Long
Dim strRtnVal As String
lngFileNum = FreeFile
Open path For Binary Access Read Shared As #lngFileNum
strRtnVal = String$(FileLen(path), vbNullChar)
Get #lngFileNum, , strRtnVal
Close #lngFileNum
GetFileText = strRtnVal
End Function

Private Sub CreateEmptyFile(ByVal path As String)
Dim lngFileNum As Long
lngFileNum = FreeFile
Open path For Binary Access Write As #lngFileNum
Close #lngFileNum
End Sub

 

[John_w]

Welcome to MrExcel forums.

However, if there is another workbook also open at the same time as this workbook. Then the macro loops and re-opens the workbook which has just been closed.

That behaviour occurs if the Application.OnTime timer isn't cancelled before closing the workbook containing the scheduled OnTime procedure.

It's all explained at Pearson Software Consulting. In short, store the OnTime scheduled time in a Public variable (e.g. RunWhen) and call StopTimer to cancel the timer.

PS please post VBA code inside CODE tags - the # icon in the message editor.

 

[Hubbert2992]

Welcome to MrExcel forums.

That behaviour occurs if the Application.OnTime timer isn't cancelled before closing the workbook containing the scheduled OnTime procedure.

It's all explained at Pearson Software Consulting. In short, store the OnTime scheduled time in a Public variable (e.g. RunWhen) and call StopTimer to cancel the timer.

PS please post VBA code inside CODE tags - the # icon in the message editor.

Thanks John,

Could you help me out with the solution as I've been working days on this and have quite frankly taken a break from it.

Thanks

- Hubbert

 

[John_w]

Add to ThisWorkbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Add at the top of the standard module:

Public RunWhen As Double

Change the OnTime to:

RunWhen = DateAdd("s", 1, Now)
Application.OnTime RunWhen, "KickCatcher"

Add to the module:

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen,Procedure:="KickCatcher", Schedule:=False
End Sub

 

[Hubbert2992]

Thanks John.

Tried and tested it and it works perfectly.
Yet again thanks a lot for your help.

- Hubbert