Avatar of JesNoFear
JesNoFear
Flag for United States of America

asked on 

Search Cross Domain accounts with VB6 or VBScript

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

DatabasesActive DirectoryVB Script

Avatar of undefined
Last Comment
RobSampson

8/22/2022 - Mon