Visual Basic Programming Code Examples Visual Basic > Database SQL Stuff Code Examples Retrieve a list of the users logged on to an Access-Jet Database Retrieve a list of the users logged on to an Access-Jet Database Below is a routine which determines the users logged into an access database. A sample routine showing how to call the code is at the bottom of this post. Option Explicit '----------Type to hold results------------ 'For each person who opens a shared database, the Jet database engine writes an entry 'in the database's .ldb file. The size of each .ldb entry is 64 bytes. The first 32 'bytes contains the computer name. The second 32 bytes contains the 'security name (such as Admin). Private Type tDBUser UserName As String * 32 SecurityName As String * 32 End Type 'Purpose : Retreives a list of users attached to an Access Database by parsing the ldb file 'Inputs : asUsers See outputs ' sLDBFilePath The path and file name of the ldb file 'Outputs : asUsers A 2d string array 1 to 2, 1 to Number of users ' Where asUsers(1,1) = First user name ' asUsers(2,1) = User's security access ' Returns 0 if their are no users or the lock file doesn't exist. ' Returns -1 on error. Function DatabaseUsers(ByRef asUsers() As String, sLDBFilePath As String) As Long Const clMaxUsers As Long = 255 'The maximum number of concurrent users that the Jet database engine supports is 255 Dim iFileNum As Integer Dim tThisUser As tDBUser On Error GoTo ErrFailed If Len(Dir$(sLDBFilePath)) > 0 And Len(sLDBFilePath) > 0 Then 'Lock file exists, open file. iFileNum = FreeFile Open sLDBFilePath For Random As #iFileNum Len = Len(tThisUser) 'Create buffer to store results ReDim asUsers(1 To 2, 1 To clMaxUsers) 'Read data into fixed length type Get iFileNum, 1, tThisUser Do While Not EOF(iFileNum) DatabaseUsers = DatabaseUsers + 1 asUsers(1, DatabaseUsers) = Left$(tThisUser.UserName, InStr(1, tThisUser.UserName, vbNullChar) - 1) asUsers(2, DatabaseUsers) = Left$(tThisUser.SecurityName, InStr(1, tThisUser.SecurityName, vbNullChar) - 1) 'Read next record Get iFileNum, DatabaseUsers + 1, tThisUser Loop 'Close file Close #iFileNum 'Resize results ReDim Preserve asUsers(1 To 2, 1 To DatabaseUsers) Else 'No users attached Erase asUsers End If Exit Function ErrFailed: DatabaseUsers = -1 Erase asUsers End Function 'Demonstration routine Sub Test() Dim asUsers() As String, lNumUsers As Long, lThisUser As Long lNumUsers = DatabaseUsers(asUsers, "D:\Work\Visual Basic\Net Send\NetSend.ldb") For lThisUser = 1 To lNumUsers Debug.Print "User Name: " & asUsers(1, lThisUser) Debug.Print "Security : " & asUsers(2, lThisUser) Next End Sub