Function IsOpenedExclusive() As String
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    
    'cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Program Files\Microsoft " & _
    "Office\Office11\Samples\Northwind.mdb;"
    Set cnn = CurrentProject.Connection
    Set rs = cnn.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    'Set rs = cnn.OpenSchema(adSchemaProviderSpecific _
    , , JET_SCHEMA_USERROSTER)
    Dim strUsers As String
    Dim intUsers As Integer
    Do While Not rs.EOF
        strUsers = strUsers & vbCrLf & Left(rs.Fields(1), Len(Trim(rs.Fields(1))) - 1) & "@" & Left(rs.Fields(0), Len(Trim(rs.Fields(0))) - 1)
        intUsers = intUsers + 1
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    IsOpenedExclusive = strUsers
End Function