Prevent loading the same EXE twice in parallel

Hello,

I use all my EXE projects the feature: “Save changes automatically and load them without prompt next time”.

From time to time my end users complained that sometimes the EXE not saves there work, for me it was an enigma because after every significant sub or functionI I save the EXE file with VBA code (my projects is 100% pure VBA code).

Few days ago, one of my end users lost 8 hours of work because the EXE didn’t save what he did.

After hours of checking my VBA code without any luck, I noticed that, if end user opens the EXE file (lets call it instance1), and then opens the EXE again(lets call it instance2), he can work 8 hours on instance2 close it (without notice that instance1 was open all the time in parallel), and then if he saves instance1, all the work of instance2 will override.

My suggestion is a feature that “Prevent loading the same EXE twice in parallel”.

I know that in the XLS Padlock you have feature that prevent loading other instance of excel all together, but I cant use it because I cant prevent my end user from loading Excel whan thay use the my EXE file.

What do you think ?

thank you.

I had this issue in the past but solved it through a simple workaround.
Upon opening the xls padlock file it will check if a text file exists “FileOpen.txt”
If the file exists it warns the user to not proceed. And asks if they want to close the application. If they select “yes” it closes with out saving.

When the xls padlock file opens normally it writes the text file “FileOpen.txt”.
When the usere finishes normally - They need to select a close icon - then the “FileOpen.txt” is deleted.

Simple and has prevented overwriting.

Thank you !, but this kind of solutions I have plenty my suggestion is a check box feature that you can tik - “Prevent loading the same EXE twice in parallel”

Hi Adworzak, would you be so kind and share your vba workaround with us? I am trying to solve the same problem. Thanks

My guess is that it’s using the File System Object, passing in the folder where the EXE is located in order to create or read the TXT file.

I haven’t used that exactly myself, but here is some code to get you going:

If XLSPadlockAvailable() Then
Dim XLSPadlock
Dim PathToFile
Set XLSPadlock = Application.COMAddIns(“GXLSForm.GXLSFormula”).Object
PathToFile = XLSPadlock.PLEvalVar(“EXEPath”)
End If

Set fso = New FileSystemObject
If fso.FileExists(PathToFile & “\” & “FileOpen.txt”) Then
'Warn user file is open and do stuff accordingly
'ADD CODE HERE TO CLOSE ETC
Else
'Create the file
fso.CreateTextFile (PathToFile & “\” & “FileOpen.txt”)
'CALL YOUR MAIN PROCEDURE HERE
'REMEMBER TO DELETE THE FileOpen.txt FILE ON YOUR PROGRAM’S EXIT
End If
Set fso = Nothing

CREATE FILE: fso.CreateTextFile (PathToFile & “\” & “FileOpen.txt”)
DELETE FILE: fso.DeleteFile (PathToFile & “\” & “FileOpen.txt”)

The firts lot of code is in (Microsoft Excel Objects) > ThisWorkbook

Sub Workbook_Open()
Application.Run “Test_if_File_Open”
End Sub

The following code is in normal modules

Private Sub Test_if_File_Open()
'Test for when file open is already open
'Check to see if file is open

Dim SourceFile As String
Dim Filepath As String
Dim Ret

Dim XLSPadlock As Object
Set XLSPadlock = Application.COMAddIns("GXLSForm.GXLSFormula").Object
Filepath = XLSPadlock.PLEvalVar("EXEPath")
SourceFile = Filepath + "Setup\FileOpenLog.txt"

Ret = DoesFileopen_Exist(SourceFile)

If Ret = True Then

    'send warning message and check if should be open
    
   If MsgBox("CRITICAL WARNING" _
    & vbNewLine & vbNewLine & _
    "This version of PROGRAM NAME appears to be already open under you or a different user, or not shutdown properly from the last time." & vbNewLine & vbNewLine & _
    "Please check if already open. Close the incorrect version otherwise you run the risk of overwriting and losing data." _
    & vbNewLine & vbNewLine & _
    "To avoid this happening always use the EXIT icon on the MAIN MENU." _
    & vbNewLine & vbNewLine & _
    "Do you wish to close now.", vbYesNo + vbQuestion, "SafeBUDDY") = vbYes Then
        Application.Run "Shutdown"
    
    End If
    
    
Exit Sub
End If
'Create a fileopen file
Application.Run "CreateNotepadFileOpen"

End Sub

Private Sub Create_File_Open_File()

Dim strFile As String
Dim Filename As Variant
Dim SourceWbk As Workbook

'Set file path and source workbook
Set SourceWbk = ActiveWorkbook

Dim Filepath As String
Dim XLSPadlock As Object
Set XLSPadlock = Application.COMAddIns("GXLSForm.GXLSFormula").Object
Filepath = XLSPadlock.PLEvalVar("EXEPath")

'Test if Directory exists
If Dir(Filepath & "Setup\", vbDirectory) = "" Then
   MkDir Filepath & "Setup\"
End If

'if file doesnt exist then create a file
strFile = “FileOpen.txt” _

strFile = Filepath & "Setup\" & strFile
Workbooks.Add

'Save workbook
Set XLSPadlock = Application.COMAddIns(“GXLS.GXLSPLock”).Object
XLSPadlock.SetOption Option:=“2”, value:=“0”
XLSPadlock.SetOption Option:=“1”, value:=“1”
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strFile, FileFormat:=xlTextMSDOS, ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
XLSPadlock.SetOption Option:=“2”, value:=“1” 'resets default save behaviour
XLSPadlock.SetOption Option:=“1”, value:=“0”

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = False

End Sub

Code has now been uploaded in post. Sorry for delay