G
Graham R Seach
Guest
Hi all,
I'm using VBA in Microsoft Access 2016 because that's what the application is written in, but I'm hoping that at least one of you remembers how to use VB6 (or in this case VBA7). This application is installed on 3 terminal servers (Windows Server 2016); one in Sydney, one in LA and one in London.
I need to be able to determine which country is the user's base (default) location. The network admins have already done so (for their own purposes) by adding each user into a specific AD user group ("AU", "US" and "UK"), and it's this group that I'd like to check in order to work out the user's base location. Please note the screen capture lower down in this post.
When I call the procedure using ADGroupMember("Fred Bloggs", "AU"), I get the following error:
Automation error
There is no such object on the server.
Here is the code I'm using:
Public Function ADGroupMember(ByVal strADUser As String, ByVal strADGroup As String) As Boolean
On Error GoTo Proc_Err
Dim objConnection As ADODB.Connection
Set objConnection = New ADODB.Connection
'CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "ADs Provider" '"Provider=ADsDSOObject;"
Dim objCommand As ADODB.Command
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
Dim strDomain As String
strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
Dim objRecordSet As ADODB.Recordset
Dim oUser As IADsUser
Dim oGroup As IADsGroup
Dim groupMember As IADsUser
Dim groupMemberList As IADsMembers
ADGroupMember = False
' User SystemInternals ADExplore.exe to get LDAP info
Set oUser = GetObject("LDAP://cn=" + strADUser + ",OU=SBSUsers,OU=Users,OU=MyBusiness," + strDomain)
Set oGroup = GetObject("LDAP://cn=" + strADGroup + ",OU=SecurityGroups , OU = MyBusiness, " + strDomain)
If oGroup.Members.Count > 0 Then
Set groupMemberList = oGroup.Members
For Each groupMember In groupMemberList
Debug.Print groupMember.Name ' Optional for testing
If groupMember.Name = oUser.Name Then
ADGroupMember = True ' Exit For if not testing
End If
Next
End If
Proc_Exit:
On Error Resume Next
' Cleanup
Set oUser = Nothing
Set oGroup = Nothing
Set groupMemberList = Nothing
Set groupMember = Nothing
' Close connection
If Not objConnection Is Nothing Then
objConnection.Close
End If
Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Exit Function
Proc_Err:
Debug.Print Err.Description
ADGroupMember = False
Resume Proc_Exit
Resume
End Function
Here's a screencap of the AD arrangement:
Clearly I must be doing something wrong, so any insight you might be able to offer will be greatly appreciated.
Regards, Graham R Seach Sydney, Australia
Continue reading...
I'm using VBA in Microsoft Access 2016 because that's what the application is written in, but I'm hoping that at least one of you remembers how to use VB6 (or in this case VBA7). This application is installed on 3 terminal servers (Windows Server 2016); one in Sydney, one in LA and one in London.
I need to be able to determine which country is the user's base (default) location. The network admins have already done so (for their own purposes) by adding each user into a specific AD user group ("AU", "US" and "UK"), and it's this group that I'd like to check in order to work out the user's base location. Please note the screen capture lower down in this post.
When I call the procedure using ADGroupMember("Fred Bloggs", "AU"), I get the following error:
Automation error
There is no such object on the server.
Here is the code I'm using:
Public Function ADGroupMember(ByVal strADUser As String, ByVal strADGroup As String) As Boolean
On Error GoTo Proc_Err
Dim objConnection As ADODB.Connection
Set objConnection = New ADODB.Connection
'CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "ADs Provider" '"Provider=ADsDSOObject;"
Dim objCommand As ADODB.Command
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
Dim strDomain As String
strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
Dim objRecordSet As ADODB.Recordset
Dim oUser As IADsUser
Dim oGroup As IADsGroup
Dim groupMember As IADsUser
Dim groupMemberList As IADsMembers
ADGroupMember = False
' User SystemInternals ADExplore.exe to get LDAP info
Set oUser = GetObject("LDAP://cn=" + strADUser + ",OU=SBSUsers,OU=Users,OU=MyBusiness," + strDomain)
Set oGroup = GetObject("LDAP://cn=" + strADGroup + ",OU=SecurityGroups , OU = MyBusiness, " + strDomain)
If oGroup.Members.Count > 0 Then
Set groupMemberList = oGroup.Members
For Each groupMember In groupMemberList
Debug.Print groupMember.Name ' Optional for testing
If groupMember.Name = oUser.Name Then
ADGroupMember = True ' Exit For if not testing
End If
Next
End If
Proc_Exit:
On Error Resume Next
' Cleanup
Set oUser = Nothing
Set oGroup = Nothing
Set groupMemberList = Nothing
Set groupMember = Nothing
' Close connection
If Not objConnection Is Nothing Then
objConnection.Close
End If
Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Exit Function
Proc_Err:
Debug.Print Err.Description
ADGroupMember = False
Resume Proc_Exit
Resume
End Function
Here's a screencap of the AD arrangement:
Clearly I must be doing something wrong, so any insight you might be able to offer will be greatly appreciated.
Regards, Graham R Seach Sydney, Australia
Continue reading...