VBA code to kick users out of shared excel file on LAN

upsfa
upsfa used Ask the Experts™
on
I have found some code to kick users out of an Excel file that is on a shared drive.  I’ve tested it and have found that file does recognize changes in the data file, but I am getting a type missmatch  error message and could use some help making this code work.

How to use:
After you have placed the code in the workbook you want, create a text file in the same folder as the workbook, with the same name as the workbook (ex: "C:\test\book1.txt"). Rename it to the ".dat" extenstion ("book1.dat"). When you are ready to boot some one put the number of the boot method in dat file (you can just open it with notepad to edit) and save it. The numbers to use are as follows:

1.) Boot one time only, prompts users for save.
2.) Always boot users until you remove the 2 from the file (prompts for save).
5.) Same as 1 no prompt for save.
6.) Same as 2 no prompt for save.


'Place in standard 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
    Application.OnTime DateAdd("s", 1, Now), "KickCatcher"
    'Get boot file name:
    strBootFile = ThisWorkbook.FullName
    strBootFile = Left$(strBootFile, InStrRev(strBootFile, ".")) & "dat"
    If Len(Dir(strBootFile)) Then
        eBootType = Val(GetFileText(strBootFile))
        If (eBootType And BootYes) <> BootNo Then
            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?", "Administrative Action", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes
            End If
            If (eBootType And BootOnce) Then
                Kill strBootFile
                CreateEmptyFile strBootFile
            End If
            Exit Sub
            ThisWorkbook.Close blnSaveChanges
        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

'Must be in "ThisWorkBook" module:
Private Sub Workbook_Open()
    KickCatcher
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2012

Commented:
There's a syntax problem with line 27, as the buttons and title parameters are reversed, and should be written as:

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

Open in new window


You can also name the parameters, then order doesn't matter:
blnSaveChanges = MsgBox(prompt:="The author of this document has booted you." & vbNewLine & vbNewLine & "Do you want to save your work?", Buttons:=vbQuestion + vbYesNo + vbDefaultButton1, Title:="Administrative Action") = vbYes

Open in new window


Here's your complete code (in the public module):
'Place in standard 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
    Application.OnTime DateAdd("s", 1, Now), "KickCatcher"
    'Get boot file name:
    strBootFile = ThisWorkbook.FullName
    strBootFile = Left$(strBootFile, InStrRev(strBootFile, ".")) & "dat"
    If Len(Dir(strBootFile)) Then
        eBootType = Val(GetFileText(strBootFile))
        If (eBootType And BootYes) <> BootNo Then
            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
        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

Open in new window


Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
The way the code works, re: the Application.OnTime command, launches KickCatcher routine every second.

That means, that even if the user closes the workbook, it will re-launch within one second, so it can run that KickCatcher routine.

Also, once the user is "booted" as a result of line 34, and the file is closed, it would be reopened within one second.

Is this the behavior you want?

If not, then the Application.OnTime command needs to have a termination step, so that it doesn't get relaunched.

What is the behavior you want, or do you need further help?

Dave

Author

Commented:
I haven't tested your solution yet, but the idea is to put a number in the dat file, which will kick the user out of the Excel file, then I go back and remove the number from the dat file which should prevent the next user from getting kicked out, and will not keep relaunching the file (I did not write this code, just "borrowed" it).

The problem is that we are trying to solve is that we have some shared files on the LAN that we periodically update, and can not make updates when users are in the file.  So we just want to kick them out long enough to copy and updated version of the file to the LAN (the users don't update these files, they contain reports with drill down and filtering capability).
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

Most Valuable Expert 2012
Top Expert 2012

Commented:
Ok - well, there need to be some modifications.  The existing code, not only causes a relaunch of the workbook, but also clears the .dat file, which I assume you really want to do manually.

Dave

Author

Commented:
Correct.  I would put a number in the dat file.  Leave it there until i have deleted the Excel file, then remove the number, then paste the new Excel file (actually I would probably just delete the Excel and dat file at the same time, and copy/paste the new Excel, along with an empty dat file).

I dont want the book to relaunch, really just want to kick people out, actually offering to save is not even good for me since often people are at lunch, gone home, etc., so the message would not help.  Just want to kick them out and replace file with corrected or updated file.
Most Valuable Expert 2012
Top Expert 2012
Commented:
I've tested the below code and it works for options 1, 2, 5, 6 as you've documented.

I've modified the code to deal with the timer issue, so the workbook doesn't resurrect itself, after its been closed.

Note, if users try to open the file, they will get a lock on it, for the time until it boots them back off (re: Persistent state), but that should only be for a "quick second".  Obviously, you could set the .dat file to 5/6, then move the file out of the folder - once done successfully, you'll know you have control at that point.

Here's the code:

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:
    strBootFile = ThisWorkbook.FullName
    strBootFile = Left$(strBootFile, InStrRev(strBootFile, ".")) & "dat"
    
    If Len(Dir(strBootFile)) 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

Open in new window


Dave

Author

Commented:
Great job, works awsome!  One question:  Can you explain this statement - "If Len(Dir(strBootFile)) Then"?  It seems to be missing something.  If the length of the file name is ____ Then...

Author

Commented:
Perfect!
Most Valuable Expert 2012
Top Expert 2012

Commented:
If Len(Dir(strBootFile)) > 0 is just checking to see if the boot.dat file exists, and only if it does does it process the rest of the code.

Dir(file that does not exists) returns a zero length string.

Cheers,

Dave

Author

Commented:
Thanks much.  So it just assumes the >0.

Commented:
Hi Guys
I know this is a few years old but I found this article today but cant quite get it to work, I get a compile error, User defined type not defined, I think I have done everything as per instructions but again you will have to forgive me I am Fairly new
TEST.xlsm

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial