Search Cross Domain accounts with VB6 or VBScript

Posted on 2010-09-07

1 solution

1,865 Views

Last Modified: 2013-12-24

I am trying to search across three of our domains for e-mail addresses.
i have created a program that modifys accounts in active directory, works great, worked for over a year. but now we have expanded the scope some and now users outside of our own domain have access, wich is great. but when my program finishes it emails whom ever entered the entry. the program is unable to find users in the other domains.
Here is a clip from my script that it uses.

it searches same domain fine, its just cross domain it dose not like.
- JES

Public Sub ITSSEmailRef(ITSS_UN As String)
'ITSSREF
Dim ESchk As Integer, SECchk As Integer, MDchk As Integer

On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.activeconnection = objConnection

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

'If WhoAmI = "ES" Then
If UCase(Left(ITSS_UN, 2)) = "ES" Then
ChkES:
Logging 0, "Searching " & ITSS_UN & " aginst ES domain", False, Form1.lblMOVE(0)
ESchk = 1
'objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=ES,dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND userPrincipalName='" & Right(ITSS_UN, Len(ITSS_UN) - 3) & "@MCPSMD.Org'"
objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=ES,dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND sAMAccountName='" & Right(ITSS_UN, Len(ITSS_UN) - 3) & "'"
'ElseIf WhoAmI = "SEC" Then
ElseIf UCase(Left(ITSS_UN, 3)) = "SEC" Then
ChkSEC:
Logging 0, "Searching " & ITSS_UN & " aginst SEC domain", False, Form1.lblMOVE(0)
SECchk = 1
'objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=SEC,dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND userPrincipalName='" & Right(ITSS_UN, Len(ITSS_UN) - 4) & "@MCPSMD.Org'"
objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=SEC,dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND sAMAccountName='" & Right(ITSS_UN, Len(ITSS_UN) - 3) & "'"
ElseIf UCase(Left(ITSS_UN, 6)) = "MCPSMD" Then
ChkMD:
Logging 0, "Searching " & ITSS_UN & " aginst MCPSMD domain", False, Form1.lblMOVE(0)
MDchk = 1
'objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND userPrincipalName='" & Right(ITSS_UN, Len(ITSS_UN) - 7) & "@MCPSMD.Org'"
objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND sAMAccountName='" & Right(ITSS_UN, Len(ITSS_UN) - 3) & "'"
Else
Logging 0, "Search Refrence Failed... " & ITSS_UN, False, Form1.lblMOVE(0)
objCommand.commandtext = _
    "SELECT Name, mail FROM 'LDAP://dc=ES,dc=MCPSMD,dc=ORG' WHERE objectCategory='user'" & _
        "AND userPrincipalName='" & "SPRUILLJ" & "@MCPSMD.Org'"
Logging "9", "ERR - Account Lookup, Unknown Domain User - " & ITSS_UN & " - " & Form1.lblMOVE(0), True, Form1.lblMOVE(0)
End If

'######################### OVERRIDE ################################
    If UCase(ITSS_UN) = "MCPSMD\FLAHERTS" Then
        Logging "9", "Override Used - MCPSMD\FLAHERTS", False, Form1.lblMOVE(0)
        ITSSREF = "Stephanie_M_Flaherty@MCPSMD.org"
        GoTo MailOverrideJump
    End If
'###################################################################


Set objRecordSet = objCommand.Execute

Debug.Print objRecordSet.Count

objRecordSet.MoveFirst
'Do Until objRecordSet.EOF
    'MsgBox objRecordSet.fields("Name").Value
    'MsgBox objRecordSet.fields("mail").Value
    ITSSREF = objRecordSet.fields("mail").Value
'    objRecordSet.MoveNext
'Loop

If ITSSREF = "" Then
'No entry
'ITSSREF = "NoMail"
If ESchk = 0 Then
    GoTo ChkES
End If
If SECchk = 0 Then
    GoTo ChkSEC
End If
If MDchk = 0 Then
    GoTo ChkMD
End If
Logging "30", "Checked all domain, E-mail not found for " & ITSS_UN & ".", False, Form1.lblMOVE(0)
ITSSREF = "Jason_Spruill@MCPSMD.org"
Logging "9", "ERR - Account Lookup " & ITSS_UN & " - " & ITSSREF & ".", True, Form1.lblMOVE(0)
End If

MailOverrideJump:

'On Error Resume Next
'Set objUser = GetObject("LDAP://cn=" & Right(ITSS_UN, Len(ITSS_UN) - 2) & ",ou=ESUSS,dc=ES,dc=MCPSMD,dc=ORG")
'If Err <> 0 Then
'    MsgBox Err
'Else
'    ITSSREF = objUser.mail
'End If
Logging "9", "REF - Account Lookup " & ITSS_UN & " - " & ITSSREF & ".", False, Form1.lblMOVE(0)






End Sub

Open in new window

3 Comments

LVL 65

Accepted Solution

by:RobSampson

RobSampson earned 500 total points

ID: 336232942010-09-07

Hi, try forcing your connection to a specific domain controller for each domain that you're connecting to, by using the LDAP string such as:
'LDAP://MyDomainController1/dc=ES,dc=MCPSMD,dc=ORG'
or
'LDAP://MyDomainController2/dc=SEC,dc=MCPSMD,dc=ORG'

Then, under this line
      objConnection.Open "Active Directory Provider"

add this
      objConnection.Properties("ADSI Flag") = ADS_SERVER_BIND

And then add this
      Const ADS_SERVER_BIND = &h200

under this
      Const ADS_SCOPE_SUBTREE = 2

and see how you go.

Regards,

Rob.

LVL 2

Author Closing Comment

by:JesNoFear

ID: 336492072010-09-10

Thank you, that was part of my problem.
the other part was it pulls the domain with the login in the es\xxxxx format, well when searching aginst ad i pull off the es, but for sec it was only removing 3 letters instead of 4 as needed.

so between these two changes, it now workes great!

Thank you

Expert Comment

ID: 336516922010-09-10

Very good. Thanks for the info, and the grade.

Regards,

Rob.

Course Of The Month

Search Cross Domain accounts with VB6 or VBScript

Welcome to Experts Exchange

Featured Post

Suggested Courses

622 members asked questions and received personalized solutions in the past 7 days.

Enjoyed your answer?

Keep in touch with Experts Exchange

Live Consultants