troubleshooting Question

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

Avatar of upsfa
upsfa asked on
Microsoft ExcelVBA
11 Comments1 Solution4979 ViewsLast Modified:
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
    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()
End Sub
Join our community to see this answer!
Unlock 1 Answer and 11 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 11 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros