Detectar usuarios activos de una base de datos (*accdb)

Tengo un código que lee los usuarios activos de una base de datos (*mdb), pero necesito que funcione para la extensión .accdb

Favor su ayuda.

Option Compare Database
Option Explicit

Const adhcUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"

Function DameUsuariosADO() As String
Dim CnnConexionAdo As ADODB.Connection
Dim RsADO As ADODB.Recordset
Dim StrCadena As String
'Aqui viene la modificacion sobre versiones anteriores.
'Mediante una API y para sistemas Win XP/2000/NT saco el nombre del
'usuario activo

Dim UsuarioActivoWindows As String
'=================================
Set CnnConexionAdo = New ADODB.Connection
Set RsADO = New ADODB.Recordset
Set CnnConexionAdo = CurrentProject.Connection
Set RsADO = CnnConexionAdo.OpenSchema(schema:=adSchemaProviderSpecific, schemaid:=adhcUsers)
While Not RsADO.EOF = True
'Utilizo Replace, para en un mismo string, quitar los caracteres
'no imprimibles que se presentan en el recordset
'Pero antes saco el usuario activo de la maquina
UsuarioActivoWindows = DameUsuarioRed(Trim(RsADO!computer_name))
StrCadena = StrCadena & Replace(Trim(RsADO!computer_name) & ";" & UsuarioActivoWindows & ";" & Trim(RsADO!LOGIN_NAME), vbNullChar, "") & "; Verdadero;"
RsADO.MoveNext
Wend
RsADO.Close
Set RsADO = Nothing
CnnConexionAdo.Close
Set CnnConexionAdo = Nothing
DameUsuariosADO = "Ordenador;Usuario Windows;Usuario MDB;Conectado;" & StrCadena
End Function