Get contents of laccdb file through VBA - ms-access

Question

I want to be able to view the contents of my access database's laccdb file through VBA so I can use it to alert users (through a button) who else is in the database.
I specifically don't want to use a 3rd Party tool. I have tried using:
Set ts = fso.OpenTextFile(strFile, ForReading)
strContents = ts.ReadAll
This works fine if only 1 user is in the database. But for multiple users it gets confused by the presumably non-ASCII characters and goes into this kind of thing after one entry:
Does anyone have any suggestions? It's fine if I just open the file in Notepad++...
Code eventually used is as follows (I didn't need the title and have removed some code not being used):
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
cn.Provider = "Microsoft.ACE.OLEDB.12.0"
cn.Open "Data Source=" & CurrentDb.Name
Set rs = cn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
While Not rs.EOF
Debug.Print rs.Fields(0)
rs.MoveNext
Wend
End Sub

Answer 1

I found this which should help, it's not actually reading the ldb file, but it has the info that you need (Source: https://support.microsoft.com/en-us/kb/198755):
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=c:\Northwind.mdb"
cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=c:\Northwind.mdb"
' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
'Output the list of all users in the current database.
Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
"", rs.Fields(2).Name, rs.Fields(3).Name
While Not rs.EOF
Debug.Print rs.Fields(0), rs.Fields(1), _
rs.Fields(2), rs.Fields(3)
rs.MoveNext
Wend
End Sub

Answer 2

I put together some code to read through the lock file and output a message listing users currently using the system.
Trying to read the whole file in at once seems to result in VBA treating the string as Unicode in the same way notepad does so I read in character by character and filter out non printing characters.
Sub TestOpenLaccdb()
Dim stm As TextStream, fso As FileSystemObject, strLine As String, strChar As String, strArr() As String, nArr As Long, nArrMax As Long, nArrMin As Long
Dim strFilename As String, strMessage As String
strFilename = CurrentProject.FullName
strFilename = Left(strFilename, InStrRev(strFilename, ".")) & "laccdb"
Set fso = New FileSystemObject
Set stm = fso.OpenTextFile(strFilename, ForReading, False, TristateFalse) 'open the file as a textstream using the filesystem object (add ref to Microsoft Scripting Runtime)
While Not stm.AtEndOfStream 'Read through the file one character at a time
strChar = stm.Read(1)
If Asc(strChar) > 13 And Asc(strChar) < 127 Then 'Filter out the nulls and other non printing characters
strLine = strLine & strChar
End If
Wend
strMessage = "Users Logged In: " & vbCrLf
'Debug.Print strLine
strArr = Split(strLine, "Admin", , vbTextCompare) 'Because everyone logs in as admin user split using the string "Admin"
nArrMax = UBound(strArr)
nArrMin = LBound(strArr)
For nArr = nArrMin To nArrMax 'Loop through all machine numbers in lock file
strArr(nArr) = Trim(strArr(nArr)) 'Strip leading and trailing spaces
If Len(strArr(nArr)) > 1 Then 'skip blank value at end
'Because I log when a user opens the database with username and machine name I can look it up in the event log
strMessage = strMessage & DLast("EventDescription", "tblEventLog", "[EventDescription] like ""*" & strArr(nArr) & "*""") & vbCrLf
End If
Next
MsgBox strMessage 'let the user know who is logged in
stm.Close
Set stm = Nothing
Set fso = Nothing
End Sub