Getting Group User is Member of in ADOX

[gavjb]

Hi,

I have just wirtten/modified some code to check if a specified user is a member of a specified group, but when I run it I get the following error everytime, does anyone know how to stop this, I have tried logging out and loggin in and running the code before I do anything else.

"-2147467259 The database has been placed in a state by user 'system' on machine 'DESKTOP' that prevents it from being opened or locked."

Function ADOXgroup(strUserName As String, strGroup As String) As Boolean
Dim conn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim ConnStr As String
Dim MdwLocation As String
On Error GoTo Error
MdwLocation = "Jet OLEDB:System database=" & SysCmd(acSysCmdGetWorkgroupFile)
ConnStr = "data source=" & CurrentDb.Name & ";" & MdwLocation & ";user id=" & MdwUser & ";Password='" & MdwPwd & "'"
With conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = ConnStr
    .Open
End With

Set cat.ActiveConnection = conn
If cat.Users(strUserName).Groups(strGroup).Name Then ADOXgroup = True

Exit Function
Error:
    MsgBox Err.Number & " " & Err.Description
    Debug.Print Err.Number & " " & Err.Description
End Function

Give me DAO I never had these problems with DAO!!


Thanks,


Gavin,

 

[gavjb]

I have made a couple of changes which mean the function now runs once, but thereafter I get the error message, for some reason the procedure seems to lock either the mdb or mdw

Function ADOXgroup(strUserName As String, strGroup As String) As Boolean
Dim conn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim ConnStr As String
Dim MdwLocation As String
On Error GoTo ADOXgroup_Error
MdwLocation = "Jet OLEDB:System database=" & SysCmd(acSysCmdGetWorkgroupFile)
ConnStr = "data source=" & CurrentDb.Name & ";" & MdwLocation & ";user id=" & MdwUser & ";Password='" & MdwPwd & "'"
With conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = ConnStr
    .Open
End With

Set cat.ActiveConnection = conn
If cat.Users(strUserName).Groups(strGroup).Name <> "" Then ADOXgroup = True

ADOXgroup_Exit:
    On Error Resume Next
    conn.Close
    Set conn = Nothing
    Exit Function

ADOXgroup_Error:
    Debug.Print Err.Number & " " & Err.Description
    ADOXgroup = False
    Resume ADOXgroup_Exit
    
End Function

 

[JerryKlmns]

Well gavjb you don't have to go to ADOX for that! You can play with .... the system database!

Function ADOgroup(strUserName As String, strGroup As String) As Boolean

Dim SysCnn As ADODB.Connection
Dim rstEnumerate As ADODB.Recordset
Dim SysPath As String
Dim SysConnection As String
Dim strSQL As String

SysPath = SysCmd(acSysCmdGetWorkgroupFile)
SysConnection = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & SysPath & _
                ";Jet OLEDB:System database=" & SysPath & _
                ";User Id='" & MdwUser & "';" & _
                "Password='" & MdwPwd & "';"

Set SysCnn = New ADODB.Connection
SysCnn.Open SysConnection

strSQL ="SELECT DISTINCT MSysAccounts_1.Name " & _
        "FROM (MSysAccounts INNER JOIN MSysGroups ON MSysAccounts.SID = MSysGroups.UserSID) " & _
        "INNER JOIN MSysAccounts AS MSysAccounts_1 ON MSysGroups.GroupSID = MSysAccounts_1.SID " & _
	"WHERE (((MSysAccounts_1.Name)='" & strGroup & "') AND ((MSysAccounts.Name)='" & strUserName & _
	"') AND ((MSysAccounts.FGroup)=0) AND ((MSysAccounts_1.FGroup)<>0));

Set rstEnumerate = New ADODB.Recordset
With rstEnumerate
    .ActiveConnection = SysCnn
    .CursorLocation = adUseServer
    .CursorType = adOpenStatic
    .LockType = adLockReadOnly
    .Source = strSQL
    .Open
    If .BOF And .EOF Then
        ADOgroup = True
    Else
        ADOgroup = False
    End If
    .Close
End With

Set rstEnumerate = Nothing
SysCnn.Close
Set SysCnn = Nothing

End Function

 

[easyit]

Hi,

Yes that is an anoying error. I have it several times a week. It seems to happen when de DB is losing its compiled state (could happen when switching to vba editor and edit code) and when I'm logged in as an administrator. My solution is exit db restart and test functionality or sometimes just saving in the vba editor and compiling works.


EasyIT

 

[gavjb]

Hi,

Thanks for the help, nice to know that I am not the only one having this issue, I have just tried the code, and for some reason if I run it as follows

? ADOGroup("Admin","Users")

it returns False

but if I run it with an nonexistant group

? ADOGroup("Admin","AccessGroup")
it returns true

From the code I would have thought it would be the other way round any ideas.

 

[JerryKlmns]

And forgot to mention that, do destroy the object cat, before closing the connection....

 

[JerryKlmns]

Just saw the other post

Reverse the logic then

If .BOF And .EOF Then
ADOgroup = False
Else
ADOgroup = True
End If

 

[easyit]

Another improvement would be to replace the following:

MdwLocation = "Jet OLEDB:System database=" & SysCmd(acSysCmdGetWorkgroupFile)
ConnStr = "data source=" & CurrentDb.Name & ";" & MdwLocation & ";user id=" & MdwUser & ";Password='" & MdwPwd & "'"
With conn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = ConnStr
    .Open
End With

Set cat.ActiveConnection = conn

with

Set cat.ActiveConnection = CurrentProject.Connection

And on exiting indeed

 set cat = nothing

EasyIT