The WhosOn() code was originally created by Mark Nally for Access 2.0, but
it is still perfectly valid (even though it is ancient). The problem is you
are looking at the LDB file for the front end, rather than for the back end
database. To view the LDB file for the back end, you have to supply the
database name of a linked table.
The offending section of code is this:
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
sUserList = ""
vTempList = GetUserList(dbCurrent.Name, sUserList)
You need to send the file name (with the entire path) to the GetUserList
function.
One way to do this is with ADO:
'********************************
Function FindSource() As String
'this function finds the Connect string of the first
'linked table in the hidden 'MSysObjects' table. It then
'returns just the path & filename. Note: this assumes all
'of the linked tables are in the same file. If this is not
'true, you can replace the DFirst function with the name of
'a specific linked table.
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim strLinkedTable As String
cat.ActiveConnection = CurrentProject.Connection
Dim txtLinkedTable As String
txtLinkedTable = DFirst("Name", "MSysObjects", "[Type] = 6")
'MsgBox txtLinkedTable
Set tbl = cat.Tables(txtLinkedTable)
'MsgBox tbl.Properties("jet OLEDB:Link Datasource")
FindSource = tbl.Properties("jet OLEDB:Link Datasource")
End Function
'********************************
Then you can supply the back-end database file name like this:
vTempList = GetUserList(FindSource(), sUserList)
Note: for reference the WhosOn code is listed below:
'*************************************************
Option Compare Database
Option Explicit
'Originally written for Access 2 by Mark Nally
'Revised an updated for Access 97 by:
'
Private Type UserRec
bMach(1 To 32) As Byte ' 1st 32 bytes hold machine name
bUser(1 To 32) As Byte ' 2nd 32 bytes hold user name
End Type
Private Sub Form_Open(Cancel As Integer)
Me.LoggedOn.RowSource = WhosOn()
End Sub
Private Sub OKBtn_Click()
DoCmd.Close A_FORM, "frmLoggedOn"
End Sub
Private Sub UpdateBtn_Click()
Me.LoggedOn.RowSource = WhosOn()
End Sub
'-----------------------------------------------------------------
' Subject : WhosOn()
' Purpose : Will read *.LDB file and read who's currently
' logged on and their station name.
'
' The LDB file has a 64 byte record.
'
' The station name starts at byte 1 and is null
' terminated.
'
' Log-in names start at the 33rd byte and are
' also null terminated.
'
' I had to change the way the file was accessed
' because the Input() function did not return
' nulls, so there was no way to see where the
' names ended.
'---------------------------------------------------------------------------
----------
Private Function WhosOn() As String
On Error GoTo Err_WhosOn
Dim dbCurrent As DAO.Database
Dim sUserList As String, vTempList As Variant
' Get Path of current database
' and for an attached table path in a multi-user environment.
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
sUserList = ""
vTempList = GetUserList(dbCurrent.Name, sUserList)
If Not IsNull(vTempList) Then
sUserList = vTempList
vTempList = GetUserList(Forms!frmCurrentPaths!Text2, sUserList)
If Not IsNull(vTempList) Then sUserList = vTempList
End If
WhosOn = sUserList
dbCurrent.Close
Set dbCurrent = Nothing
Exit_WhosOn:
Exit Function
Err_WhosOn:
Resume Exit_WhosOn
End Function
Private Function GetUserList(sSourcePath As String, sCurrentLogins) As
Variant
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
On Error GoTo Err_GetUserList
GetUserList = Null
sPath = Left(sSourcePath, InStr(1, sSourcePath, ".")) + "LDB"
' Test for valid file, else Error
x = Dir(sPath)
iStart = 1
sLogins = sCurrentLogins
iLDBFile = FreeFile
' Iterate thru LDB file for login names.
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 sLogStr <> " -- " And InStr(sLogins, sLogStr) = 0 Then
sLogins = sLogins & sLogStr & ";"
End If
iStart = iStart + 64 'increment to next record offset
Loop
Close iLDBFile
Exit_GetUserList:
GetUserList = sLogins
Exit Function
Err_GetUserList:
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_GetUserList
End Function
'*************************************************
Sam said:
Hello
I have downloaded a form that shows who is logged on, however it only shows
one person as being logged on (me) when I know that several other people are
also logged on.. The code attached to the form is as below:--
Option Compare Database 'Use database order for string comparisons
Private Sub Form_Open(Cancel As Integer)
Me.LoggedOn.RowSource = WhosOn()
End Sub
Private Sub OKBtn_Click()
DoCmd.Close A_FORM, "LoggedOn"
End Sub
Private Sub UpdateBtn_Click()
Me.LoggedOn.RowSource = WhosOn()
End Sub
Is there a way to make this list everyone within the data base, or does
anyone have a good program/ form that does this ???
