Get contents of laccdb file via VBA

Question

I want to be able to view the contents of the laccdb file of my access database via VBA, so that I can use it to notify users (with a button) who is still in the database.

I specifically do not want to use a third-party tool . I tried using:

Set ts = fso.OpenTextFile(strFile, ForReading) strContents = ts.ReadAll 

This works great if there is only 1 user in the database. But for multiple users, this confuses presumably non-ASCII characters and goes into such things after a single entry:

Anyone have any suggestions? Well, if I just open the file in Notepad ++ ...

---

Ultimately, the following code is used (I don't need the header, and I deleted the unused code):

 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 that should help, it does not actually read the ldb file, but it has the information 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 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 collected some code to read the lock file and display a message listing the users who are currently using the system.

Trying to read the entire file at one time causes VBA to treat the string as Unicode in the same way as notepad, so I read character by character and filter out non-printable 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