Get contents of laccdb file through VBA

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

score 8 · Accepted Answer · answered Sep 08 '16 at 14:02

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

That looks like a good starting point. I'm trying to work out which version of Jet I have to change to as 4.0 won't support accdb files. Any idea? — Tim Edwards, Sep 08 '16 at 14:07
I've changed it to `Microsoft.ACE.OLEDB.12.0` and used `"Data Source=" & CurrentDb.Properties(0).Value` and it appears to be working like a charm! Gracias. — Tim Edwards, Sep 08 '16 at 14:11
Nifty. @TimEdwards: `CurrentDb.Name` is a bit more readable than `CurrentDb.Properties(0).Value` :) — Andre, Sep 08 '16 at 14:14
True. For some reason in my head `CurrentDB.Name` gave **Database.accdb** rather than **C:\Database.accdb** but just tested and I was imagining things! — Tim Edwards, Sep 08 '16 at 14:17

score 0 · Answer 2 · answered Jul 02 '19 at 16:31

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

Get contents of laccdb file through VBA

2 Answers2

Linked