Alert For Exclusive Access?

[egun]

Hi,

Does anyone have a simple way of watching an Access file and letting the
user know when no one has that file opened? Excel has that ability with
shared files - it will let you know when the file is available for exclusive
access.

I need to do some editing in a back end file, but people are constantly
accessing it, and I'd like to be able to grab the file for exclusive access
if there is a moment when it's not locked by other users. If there is some
utility that will watch the file for me and then open it exclusively, that
would be very helpful.

Thanks,

Eric

 

[Douglas J. Steele]

There's nothing built into Access. Simply look for the existance of the LDB
file in the same folder as the MDB file. If it's not there, no one's using
the database.

 

[doodle]

1. Create a form called frmLoggedOn
2. Place a list box on the form called "LoggedOn"
3. Above the list box, place a label with the text "Logged On Users:"
4. Place a command button on the form named cmdOK, caption = "OK"
5. Place a second command button on the form named cmdUpdate, caption
= "Update"
6. Place the following code in the OnClick event for cmdOK:

Private Sub cmdOK_Click()

DoCmd.Close A_FORM, "frmLoggedOn"

End Sub

7. Place the following code in the OnClick event for cmdUpdate:

Private Sub cmdUpdate_Click()

Me.LoggedOn.RowSource = WhosOn()

End Sub

8. Place the following code in the On Open event for the form
"frmLoggedOn":

Private Sub Form_Open(Cancel As Integer)
On Error GoTo tagError
Dim strSQL As String

DoCmd.SetWarnings False

strSQL = "Insert INTO tblSys_TrackUser(User,UserObject)" & _
"Values ('" & fOSUserName() & "','" & Me.Name & "')"
DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

Me.LoggedOn.RowSource = WhosOn()
DoCmd.Restore

Exit Sub

tagError:
MsgBox Err.Description

End Sub

9. Place the following function in the VBA window for the form
"frmLoggedOn"

Private Function WhosOn() As String

On Error GoTo Err_WhosOn

Dim iLDBFile As Integer, iStart As Integer
Dim iLOF As Integer, i As Integer
Dim sPath As String, x As String
Dim sLogStr As String, sLogins As String
Dim sMach As String, sUser As String
Dim rUser As UserRec ' Defined in General
Dim dbCurrent As Database

' Get Path of current database. Should substitute this code
' for an attached table path in a multi-user environment.

Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
sPath = "\\Servicesrv1\Optimum\Spindle\Spindle_Database
\Spindle_DB_Tables.mdb" 'dbCurrent.Name
dbCurrent.Close

' Iterate thru dbCurrent.LDB file for login names.

sPath = Left(sPath, InStr(1, sPath, ".")) + "LDB"

' Test for valid file, else Error

x = Dir(sPath)
iStart = 1
iLDBFile = FreeFile

Open sPath For Binary Access Read Shared As iLDBFile
iLOF = LOF(iLDBFile)
Do While Not EOF(iLDBFile)
Get iLDBFile, , rUser
With rUser
i = 1
sMach = ""
While .bMach(i) <> 0
sMach = sMach & Chr(.bMach(i))
i = i + 1
Wend
i = 1
sUser = ""
While .bUser(i) <> 0
sUser = sUser & Chr(.bUser(i))
i = i + 1
Wend
End With
sLogStr = sMach '& " -- " & sUser
If InStr(sLogins, sLogStr) = 0 Then
sLogins = sLogins & sLogStr & ";"
End If
iStart = iStart + 64 'increment to next record offset
Loop
Close iLDBFile
WhosOn = sLogins

Set dbCurrent = Nothing

Exit_WhosOn:
Exit Function

Err_WhosOn:
If Err = 68 Then
MsgBox "Couldn't populate the list", 48, "No LDB File"
Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
Close iLDBFile
End If
Resume Exit_WhosOn

End Function

10. You will need to change this line of code in the function above:

sPath = "\\Servicesrv1\Optimum\Spindle\Spindle_Database
\Spindle_DB_Tables.mdb" 'dbCurrent.Name

to

sPath = "\\YourServer\Folder\NameofBackEndTables.mdb"
'dbCurrent.Name

11. You can then either open the form to see who is on or do like I
did and place a command button on your main menu with the caption
"Who's On?", that launches the form "frmLoggedOn".

-doodle