checking for exclusive access to the back-end db

[ARC]

Hello all,

When a user starts my app, I run re-attaching code if the links are not
valid, etc. In this routine, I then check the version of the back-end
database. If the version is off, I run code that then upgrades their
back-end db by adding new fields, etc.

However, if new fields are needed, I do run a function that I wrote that is
supposed to determine if there are other user's in the back-end database. If
so, it tells them to exit all other users out, and retry the upgrade. This
code used to work in access 97, but for whatever reason, doesn't work with
access 2007. If there is a better way to check for exclusive access, that
would be good too.

I'm including my function below. And by the way, I also use this function to
make sure they are not exceeding the number of users that they are licensed
for.

Here's a snippet from my upgrade / reattaching code, then the function I
call is below that:

Thanks all!
If NumUsersU(Trim(datapath)) 1 Then 'datapath= back-end database
MsgBox "You cannot upgrade your database until all other user's exit
the program. Exclusive use of the database is required for upgrades
that add new fields / tables to your database." & Chr(10) & Chr(10) & "The
program will now be shutdown. Please exit all users from the
system.", vbCritical, "Exit all users prior to upgrading"
Application.Quit acQuitSaveNone
Exit Function
End If
----------------------------------------------------------------------------

Public Function NumUsersU(DBName As String) As Integer
On Error GoTo ErrRtn
Dim UserName As String, UserRight As String, UserList As String
Dim ldbName As String
ldbName = Left(DBName, Len(DBName) - 6)
ldbName = Trim(ldbName & ".laccdb") 'check the ldb file for users, rather
than the accdb file
NumUsersU = 0
Open ldbName For Input Shared As #1
Do While Not EOF(1)
UserName = Input(31, #1)
NumUsersU = NumUsersU + 1
UserRight = Input(5, #1)
'if char = asc(32)
'Debug.Print Trim$(UserName)
UserList = UserList & Trim$(UserName) & ";"
Loop
'Debug.Print Chr(10) & Chr(13)
'Debug.Print "Number of users is: " & NumUsers
Close #1
Exit Function
ErrRtn:
NumUsersU = 1
If Err = 53 Then '.ldb file not found
'MsgBox "There are no user's in this .ldb file"
'Forms!fLoggedIn.Form!lstUsers.RowSource = ""
'Forms!fLoggedIn.Form!lstUsers.Requery
'Forms!fLoggedIn.Form!lblMsg.Caption = "Number Logged In: 0"
ElseIf Err = 62 Then
Close #1
Exit Function
Else
MsgBox Err.Number & " - " & Err.Description & ", Function: NumUsers"
End If
End Function

[lyle fairfield]

Private Function CanBeOpenedExclusively(ByVal FullPath$) As Boolean
Dim d As Database
Dim p As PrivDBEngine
Set p = New PrivDBEngine
On Error Resume Next
Set d = p(0).OpenDatabase(FullPath, True)
CanBeOpenedExclusively = Not (d Is Nothing)
p(0).Close
Set d = Nothing
Set p = Nothing
End Function
--
-
lyle fairfield

[ARC]

Perfect! Thanks, Lyle. I'll switch to your function.

Andy
"lyle fairfield" <ly******@yah00.cawrote in message
news:Xn**********************@216.221.81.119...

Private Function CanBeOpenedExclusively(ByVal FullPath$) As Boolean
Dim d As Database
Dim p As PrivDBEngine
Set p = New PrivDBEngine
On Error Resume Next
Set d = p(0).OpenDatabase(FullPath, True)
CanBeOpenedExclusively = Not (d Is Nothing)
p(0).Close
Set d = Nothing
Set p = Nothing
End Function
--
-
lyle fairfield