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
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE