Link to home
Start Free TrialLog in
Avatar of upsfa
upsfa

asked on

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

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

Avatar of dlmille
dlmille
Flag of United States of America image

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
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
Avatar of upsfa
upsfa

ASKER

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).
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
Avatar of upsfa

ASKER

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.
ASKER CERTIFIED SOLUTION
Avatar of dlmille
dlmille
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of upsfa

ASKER

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...
Avatar of upsfa

ASKER

Perfect!
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
Avatar of upsfa

ASKER

Thanks much.  So it just assumes the >0.
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