davidhall80
Well-known Member
- Joined
- Jul 8, 2006
- Messages
- 663
I've created a folder and spreadsheet on a shared drive. Since I am the Author of the document, Can I kick a user out of the document if I wish. Thanks in advance
'Must be in "ThisWorkBook" module:
Private Sub Workbook_Open()
KickCatcher
End Sub
'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 LenB(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
ThisDocument.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