Set the max number of users

[Smalley]

Need some help please. Have this code and for some reason it is not
working correctly. I am not receiving errors, just the table is not
being populated at all. I have created the tbl and the frm and when I
open up the db, it is not recording the number of users. I am still
new to VBA and would appreciate some assistance. I am running Access
2003

Thanks,
Option Compare Database
Option Explicit
'This references a table called tblSysConstants, with fields Id, and
Value.
'This constant must be set to the index number of the record holding
the
users
'value in the tblSysConstants table
Const mNdx As Integer = 1
Const maxUsers As Integer = 3 'Set the max number of users
'
Function AddUser()
Dim iValue As Integer
Dim sValue As String
iValue = Val(sysConstGet(mNdx)) + 1
sValue = Str(iValue)
Call SysConstPut(mNdx, sValue)
If iValue maxUsers Then
MsgBox "Sorry but you have reached the limit of users"
Call RemoveUser ' remove the added user before exiting.
DoCmd.Quit
End If
End Function
Function RemoveUser()
Dim iValue As Integer
Dim sValue As String
iValue = Val(sysConstGet(mNdx)) - 1
If iValue < 0 Then iValue = 0
sValue = Str(iValue)
Call SysConstPut(mNdx, sValue)
End Function
Public Function sysConstGet(ndx As Integer) As String
'returns the value in the Value field of tblSysConstants
'when the user arguament of the Id is supplied.
'table should have Id as key field
Dim db As DAO.Database
Dim rsSys As DAO.Recordset
Dim sInt As Integer
Dim sValue As Integer
Dim i As Integer
Set db = CurrentDb
Set rsSys = db.OpenRecordset("tblSysConstants", dbOpenDynaset,
dbReadOnly)
With rsSys
.MoveFirst
For i = 1 To .RecordCount
If !id = ndx Then
sysConstGet = Trim(!Value)
Else
.MoveNext
End If
Next i
End With
Set rsSys = Nothing
Set db = Nothing
End Function
Public Function SysConstPut(ndx As Integer, mValue As String)
'This put a user input value into the value field of a record
'in the tblSysConst table. Ndx is the record Id number, and
'mValue is the value to be placed in the 'Value field of this
'record
Dim db As DAO.Database
Dim rsSys As DAO.Recordset
Dim sInt As Integer
Dim sValue As Integer
Dim i As Integer
Set db = CurrentDb
Set rsSys = db.OpenRecordset("tblSysConstants", dbOpenDynaset)
With rsSys
..MoveFirst
..FindFirst !id = ndx
If Not .NoMatch Then
..Edit
!Value = mValue
..Update
Else
MsgBox "No record match"
End If
End With
Set rsSys = Nothing
Set db = Nothing
End Function

[ARC]

I'm not sure about the tblSysConstants, as I've never used it. But I'll
include a function I use in Access 97 that works, so hopefully it will work
in 03 as well. Basically, when a user is connected to an .mdb file, an .ldb
file is created. I looked into this file and found that it should contain
the name of the machines logged in. So I wrote a function that will count
the names in the .ldb file. Just pass the database name to it, such as
database.mdb, and it will look in database.ldb:

--------------------
Public Function NumUsers(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) - 4)
ldbName = Trim(ldbName & ".ldb")
NumUsers = 0
Open ldbName For Input Shared As #1
Do While Not EOF(1)
UserName = Input(31, #1)
NumUsers = NumUsers + 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
'Forms!fLoggedIn.lstUsers.RowSource = UserList
'Forms!fLoggedIn.Form!lblMsg.Caption = "Number Logged In: " & NumUsers
Close #1
'now find the number of users logged in through all add-ins and deduct them
from the total
Exit Function
ErrRtn:
NumUsers = 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