asked on
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