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

Microsoft ExcelVBA

Avatar of undefined
Last Comment
Walker85

8/22/2022 - Mon
dlmille

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
dlmille

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
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).
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
dlmille

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
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
dlmille

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
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...
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
upsfa

ASKER
Perfect!
dlmille

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
upsfa

ASKER
Thanks much.  So it just assumes the >0.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Walker85

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