(untagged)
Using VBScript for Active Directory and Exchange

xExTxCx
0.00/5 (No votes)
24 May 2007
This is a sample script that I use to create AD/Exchange users. Modifies ADSI attributes.
Download Create_FUSD_Users_v155_.zip - 5.5 KB
Introduction

The Problem:
We are a service provider that has recently gotten into the business of Exchange Hosting. We got our clusters setup and our FE/BE configuration talking. Now we have to create users, and what's worse is that each user must have several ADSI attributes manually set so that users from one virtual server can't see other virtual servers.
Whats Worse:
Some of the new exchange clients already subscribe to our application hosting (Citrix) and already have accounts in this Active Directory...
The Solution:
VBScript to the rescue. (You might have seen that one coming.)
Background

Basic understanding of Active Directory and Exchange is *HIGHLY* recommended.
Using the code

This code is pretty much customized to our particular situation, but you should be able to "read between the lines" and see the basic concepts behind what we are doing.
'///////////////////////////////////////////////////////////'

'\\\\\\\\\ FUSD Exchange User Script V.1.5 \\\\\\\\\\\\\\\\\'

'///////////////////////////////////////////////////////////'

'\\\\\\\\\\\\\\\\\\\ Brian Velde - ETC \\\\\\\\\\\\\\\\\\\\\'

'///////////////////////////////////////////////////////////'


Dim strVersion
strVersion = "V.1.5.5 - (12/13/2006)"
Dim strFirstName
Dim strLastName
Dim strUserName
Dim strFirstLast
Dim strEmailSuffix
Dim strOU
Dim strGroupDN
Dim strSirsDN
Dim strGlobalAddrBook
Dim strOABDN
Dim strPass
Dim strDesc
Dim strDesc2
Dim strDesc3
Dim strDesc4
Dim strEmailAddr
Dim strAdtlGrp
Dim strAdtlGrp2
Dim strUserExists 
Dim strQuery    
Dim strUserDN    
Dim strMailboxExist
Dim strSamNameClear
Dim intUser
Dim strSamNew
Dim DomainDN
Dim strProfilePath
Dim strScript
Dim intMessage
Dim intMessage2
Dim strSendingEmail
Dim strReportEmail
Dim strSmtpServer
Dim strSmtpPort
Dim strSmtpAuth
Dim strSmtpUser
Dim strSmtpPass
Dim strSmtpSsl

'/====================================================================\

'\####################################################################/


strDomainDN = "DC=ifas,DC=lan"
strScript = "logon.vbs"
strPass = "!Password1"
strEmailSuffix = "@fusd1.org"
strOU = "OU=FUSD-EXCH,OU=Exchange,DC=ifas,DC=lan"
strGroupDN = "CN=FUSD-EXCH,OU=FUSD-EXCH,OU=Exchange,DC=ifas,DC=lan"
strFeaDN = "CN=FEA,OU=FUSD-EXCH,OU=Exchange,DC=ifas,DC=lan"
strSirsDN = "OU=FUSD,OU=SIRS CLIENTS,DC=ifas,DC=lan"
strGlobalAddrBook = "CN=FUSD Global Address List,CN=All Global Address Lists,CN=Address Lists Container,CN=First Organization,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=ifas,DC=lan"
strOABDN = "CN=FUSD1.org,CN=Offline Address Lists,CN=Address Lists Container,CN=First Organization,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=ifas,DC=lan"

'/####################################################################\

'\====================================================================/

strSmtpServer = "fusd-evs1.ifas.lan"
strSmtpPort = 25
strSmtpAuth = "no"
strSmtpUser = ""
strSmtpPass = ""
strSmtpSsl = "no"

strSendingEmail = "user.script@fusd1.org"
strReportEmail = "usercreate@fusd1.org"

'/####################################################################\

'\====================================================================/


Function retryCode()
    Call schlCode()
End Function

Function retryCode2()
    Call schlCode2()
End Function

Function schlCode()
    strDesc = InputBox("Please enter the user's School Code.","School Code?")
    strDesc2 = LCase(strDesc)
    strUserName = Left(strFirstName, 1) & strLastName
    strEmailAddr = strUserName & strEmailSuffix
    
    Select Case Trim(strDesc2) 
        Case ""
            WScript.Echo "No school code entered!" & VbCrLf & "Enter a valid school code."
            'WScript.Quit(998)

            Call retryCode()
        Case "admin"
            strAdtlGrp = "FUSDx-AdminCenter"
            strDesc3 = "Admin Center"
        Case "christensen"
            strAdtlGrp = "FUSDx-Christensen"
            strAdtlGrp2 = "FUSD-Christensen-SIRS"
            strDesc3 = "Christensen Elem."
        Case "chs"
            strAdtlGrp = "FUSDx-CHS"
            strAdtlGrp2 = "FUSD-CHS-SIRS"
            strDesc3 = "Coconino HS"
        Case "cromer"
            strAdtlGrp = "FUSDx-Cromer"
            strAdtlGrp2 = "FUSD-Cromer-SIRS"
            strDesc3 = "Cromer Elem."
        Case "default"
            strAdtlGrp = "FUSDx-Default"
            strDesc3 = "Default"
        Case "demiguel"
            strAdtlGrp = "FUSDx-DeMiguel"
            strAdtlGrp2 = "FUSD-DeMiguel-SIRS"
            strDesc3 = "DeMiguel Elem."
        Case "fhs"
            strAdtlGrp = "FUSDx-FHS"
            strAdtlGrp2 = "FUSD-FHS-SIRS"
            strDesc3 = "Flagstaff HS"
        Case "fms"
            strAdtlGrp = "FUSDx-FMS"
            strAdtlGrp2 = "FUSD-FMS-SIRS"
            strDesc3 = "Flagstaff MS"
        Case "killip"
            strAdtlGrp = "FUSDx-Killip"
            strAdtlGrp2 = "FUSD-Killip-SIRS"
            strDesc3 = "Killip Elem."
        Case "kinsey"
            strAdtlGrp = "FUSDx-Kinsey" 
            strAdtlGrp2 = "FUSD-Kinsey-SIRS"
            strDesc3 = "Kinsey Elem."
        Case "knoles"
            strAdtlGrp = "FUSDx-Knoles"
            strAdtlGrp2 = "FUSD-Knoles-SIRS"
            strDesc3 = "Knoles Elem."
        Case "leupp"
            strAdtlGrp = "FUSDx-Leupp"
            strAdtlGrp2 = "FUSD-Leupp-SIRS"
            strDesc3 = "Leupp School"
        Case "maint"
            strAdtlGrp = "FUSDx-Maintenance"
            strDesc3 = "Maintenance"
        Case "marshall"
            strAdtlGrp = "FUSDx-Marshall"
            strAdtlGrp2 = "FUSD-Marshall-SIRS"
            strDesc3 = "Marshall Elem."
        Case "memsrmms"
            strAdtlGrp = "FUSDx-MEMSRMMS"
            strAdtlGrp2 = "FUSD-MEMS-RMMS-SIRS"
            strDesc3 = "M.E.M.S."
        Case "district"
            strAdtlGrp = "FUSDx-DistrictWide"
            strAdtlGrp2 = "FUSD-SIRS - Access all Schools"
            strDesc3 = "District Wide"
        Case "pns"
            strAdtlGrp = "FUSDx-PNS"
            strAdtlGrp2 = "FUSD-PNS-SIRS"
            strDesc3 = "P.N.S"
        Case "puente"
            strAdtlGrp = "FUSDx-Puente"
            strAdtlGrp2 = "FUSD-Puente-SIRS"
            strDesc3 = "Puente"
        Case "sechrist"
            strAdtlGrp = "FUSDx-Sechrist"
            strAdtlGrp2 = "FUSD-Sechrist-SIRS"
            strDesc3 = "Sechrist Elem."
        Case "shs"
            strAdtlGrp = "FUSDx-SHS"
            strAdtlGrp2 = "FUSD-SHS-SIRS"
            strDesc3 = "Sinagua HS"
        Case "south beaver"
            strAdtlGrp = "FUSDx-SouthBeaver"
            strAdtlGrp2 = "FUSD-South Beaver-SIRS"
            strDesc3 = "South Beaver Elem."
        Case "tech"
            strAdtlGrp = "FUSDx-TechServices"
            strDesc3 = "Technical Services"
        Case "thomas"
            strAdtlGrp = "FUSDx-Thomas"
            strAdtlGrp2 = "FUSD-Thomas-SIRS"
            strDesc3 = "Thomas Elem."
        Case "trans"
            strAdtlGrp = "FUSDx-Transportation"
            strDesc3 = "Transportation"
        Case "warehouse"
            strAdtlGrp = "FUSDx-Warehouse"
            strDesc3 = "Warehouse"
        Case Else
            WScript.Echo "Please enter a valid school code!"
            'WScript.Quit(999)

            Call retryCode()
    End Select
End Function

Function schlCode2()
            strDesc4 = InputBox("Please enter the school's code.","School Code?") 
            strDesc4 = LCase(strDesc4)
            Select Case Trim(strDesc4) 
            Case ""
                WScript.Echo "No school code entered. Aborting."
                Call retryCode2()
                'WScript.Quit(998)

            Case "christensen"
                strAdtlGrp2 = "FUSD-Christensen-SIRS"
            Case "chs"
                strAdtlGrp2 = "FUSD-CHS-SIRS"
            Case "cromer"
                strAdtlGrp2 = "FUSD-Cromer-SIRS"
            Case "demiguel"
                strAdtlGrp2 = "FUSD-DeMiguel-SIRS"
            Case "fhs"
                strAdtlGrp2 = "FUSD-FHS-SIRS"
            Case "fms"
                strAdtlGrp2 = "FUSD-FMS-SIRS"
            Case "killip"
                strAdtlGrp2 = "FUSD-Killip-SIRS"
            Case "kinsey"
                strAdtlGrp2 = "FUSD-Kinsey-SIRS"
            Case "knoles"
                strAdtlGrp2 = "FUSD-Knoles-SIRS"
            Case "leupp"
                strAdtlGrp2 = "FUSD-Leupp-SIRS"
            Case "marshall"
                strAdtlGrp2 = "FUSD-Marshall-SIRS"
            Case "memsrmms"
                strAdtlGrp2 = "FUSD-MEMS-RMMS-SIRS"
            Case "district"
                strAdtlGrp2 = "FUSD-SIRS - Access all Schools"
            Case "pns"
                strAdtlGrp2 = "FUSD-PNS-SIRS"
            Case "puente"
                strAdtlGrp2 = "FUSD-Puente-SIRS"
            Case "sechrist elem"
                strAdtlGrp2 = "FUSD-Sechrist-SIRS"
            Case "shs"
                strAdtlGrp2 = "FUSD-SHS-SIRS"
            Case "south beaver"
                strAdtlGrp2 = "FUSD-South Beaver-SIRS"
            Case "thomas"
                strAdtlGrp2 = "FUSD-Thomas-SIRS"
            Case Else
                WScript.Echo "Please enter a valid school code! (that uses SIRS)  Aborting...."
                'WScript.Quit(999)

                Call retryCode2()
            End Select
        End Function
        
Function sendMail()
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'use '1' for local SMTP

    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
    objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSmtpPort
    If strSmtpAuth = "yes" Then
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'use '2' for NTLM authentication

        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSmtpUser
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSmtpPass
    End If
    If strSmtpSsl = "yes" Then
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    End If
    objMessage.Configuration.Fields.Update
    objMessage.Subject = "User " & strFirstLast & " was created but had to be numbered."
    objMessage.From = strSendingEmail
    objMessage.To = strReportEmail
    objMessage.TextBody = "User: " & strFirstLast & " was created, but their user account " & vbCrLf & _
                         "      had to have a number appended to it." & vbCrLf & " " & vbCrLf & "UserName: " & _
                strUserName & strEmailSuffix & vbCrLf & vbCrLf & "Email Address: " & strUserName & strEmailSuffix & _
                vbCrLf & vbCrLf & "Password: '!Password'. Please remind the user to change their" & _
                vbCrLf & "          password when they login."
    objMessage.Send
End Function

Function searchUser(strUserCN,strSearchDN) 
    Dim strYes
    Dim strBase
    Dim strFilter
    Dim strAttrs
    Dim strScope
    
    strYes = "Yes"
    strBase   =  "<ldap:>;"
    strFilter = "(&(objectclass=user)(cn=" & strUserCN & "));" 
    strAttrs  = "name;"
    strScope  = "subtree"
    
    set objConn = CreateObject("ADODB.Connection")
    objConn.Provider = "ADsDSOObject"
    objConn.Open "Active Directory Provider"
    set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
        
    If objRS.RecordCount = 1 Then
        strUserExists = strYes
        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User '" & objRS.Fields(0).Value & "' seems to exist... I will try to move that user.</li>

"
           WScript.Sleep 333    
    End If
End Function

Function searchSamName(strUserName) 
    strYes = "Yes"
    strBase   = "<ldap: dc="ifas,DC=lan">;"
    strFilter = "(&(objectclass=user)(sAMAccountName=" & strUserName & "));" 
    strAttrs  = "sAMAccountName;"
    strScope  = "subtree"
        
    set objConn = CreateObject("ADODB.Connection")
    objConn.Provider = "ADsDSOObject"
    objConn.Open "Active Directory Provider"
    set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
    
    If objRS.RecordCount = 1 Then
        strSamNameClear = "No"    
    Else
        strSamNameClear = "Yes"
    End If
End Function

Function moveUser(strUserCN,strSearchDN)
    strBase   =  "<ldap:>;"
    strFilter = "(&(objectclass=user)(cn=" & strUserCN & "));" 
    strAttrs  = "DistinguishedName;"
    strScope  = "subtree"
    
    set objConn = CreateObject("ADODB.Connection")
    objConn.Provider = "ADsDSOObject"
    objConn.Open "Active Directory Provider"
    set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
        
    'extract the DN

    strUserDN = objRS.Fields(0).Value
    
    'move the user

    Set objUser = GetObject("LDAP://" & strUserDN)
    Set objOU = GetObject("LDAP://" & strOU)
    objOU.MoveHere objUser.ADsPath, objUser.Name
        
    Set objUser = Nothing
    Set objOU = Nothing
    objRS.Close
    Set objRS = Nothing
    objConn.Close
    Set objConn = Nothing
        
    WScript.Sleep 333
End Function

Function incName(strUserName,intUser)
    intUser = intUser+1
    strSamNew = strUserName & intUser
End Function

Function createUser(strFirstName,strLastName,strFirstLast,strUsername,strPass,strDesc3)
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>Creating new user '" & strFirstLast & "'!</li>

"
    WScript.Sleep 333

    strMemberDN = "CN=" & strFirstName & " " & strLastName & "," & strOU
    strSchoolDN = "CN=" & strSchool & "," & strOU
    strProfilePath = "\\apscc-shares\profiles\" & strUserName
     
    Set objParent = GetObject("LDAP://" & strOU) 
    set objUser   = objParent.Create("user", "cn=" & strFirstName & " " & strLastName) 
    
    objUser.Put "sAMAccountName", strUserName  
    objUser.Put "userPrincipalName", strUserName & strEmailSuffix
    objUser.Put "givenName", strFirstName   
    objUser.Put "sn", strLastName           
    objUser.Put "displayName", strFirstName & " " & strLastName 
    objUser.Put "msExchQueryBaseDN", strGlobalAddrBook 'ADD DEFAULT GLOBAL ADDRESS BOOK

    objUser.Put "msExchUseOAB", strOABDN  'ADD DEFAULT OFFLINE ADDRESS BOOK

    objUser.Put "description", strDesc3    'ADD Location

    objUser.Put "physicalDeliveryOfficeName", strDesc3    'ADD Location

    objUser.Put "profilePath", strProfilePath    'add roaming profile

    objUser.Put "scriptPath", strScript        'add logon script

    objUser.SetInfo
    objUser.SetPassword(strPass) ' SET PASSWORD

    objUser.AccountDisabled = False
    objUser.SetInfo
    
    'SETS FUSD EXCH USER

    Set objGroup = GetObject("LDAP://" & strGroupDN)
    objGroup.Add("LDAP://" & strMemberDN)
    
    ' ALLOW FEA TO SEND MAIL TO EVERYONE

    Set objGroup = GetObject("LDAP://" & strFeaDN)
    objGroup.Add("LDAP://" & strMemberDN)
    
    'SETS SCHOOL AFFILIATION

    Set objGroup = GetObject("LDAP://CN=" & strAdtlGrp & "," & strOU)
    objGroup.Add("LDAP://" & strMemberDN)
    
    Set objGroup = GetObject("LDAP://CN=FUSD_show_all_printers,CN=users,DC=ifas,DC=lan")
    objGroup.Add("LDAP://" & strMemberDN)
    
    If intMessage = vbYes Or intMessage2 = vbYes Then
        'SETS SIRS Access

        Set objGroup = GetObject("LDAP://CN=" & strAdtlGrp2 & ",OU=SIRS GROUPS," & strOU)
        objGroup.Add("LDAP://" & strMemberDN)
    End If
     
End Function

Function FindAnyMDB(strConfigurationNC)
    Dim oConnection 
    Dim oCommand 
    Dim oRecordSet 
    Dim strQuery 

    ' Open the Connection.

    Set oConnection = CreateObject("ADODB.Connection")
    set oCommand = CreateObject("ADODB.Command")
    Set oRecordSet = CreateObject("ADODB.Recordset")

    oConnection.Provider = "ADsDSOObject"
    oConnection.Open "ADs Provider"

    ' Build the query to find the private MDB.

    strQuery = "<ldap:>;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

    oCommand.ActiveConnection = oConnection
    oCommand.CommandText = strQuery
    Set oRecordSet = oCommand.Execute

    If Not oRecordSet.EOF Then
        oRecordSet.MoveFirst
        FindAnyMDB = CStr(oRecordSet.Fields("ADsPath").Value)
    Else
        FindAnyMDB = ""
    End If

    oRecordSet.Close
    oConnection.Close
    Set oRecordSet = Nothing
    Set oCommand = Nothing
    Set oConnection = Nothing
End Function

Function hasMailbox(strUserDN)
    Set objUser = GetObject("LDAP://" & strUserDN)
        
    'check if user is mailbox enabled

    If objUser.HomeMDB = "" Then
        
    Else
        strMailboxExist = "Yes"
        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User was configured but seems to already have a mailbox!
You will want to verify that the user's Exchange config is correct.</li>
"
        WScript.Sleep 333
    End If
End Function

Function createMailbox(strUserCN)
    Dim oIADSUser
    Dim oMailbox
    
    Set oIADS = GetObject("LDAP://RootDSE")
    strDefaultNC = oIADS.Get("defaultnamingcontext")
        
    Set oIADSUser = GetObject("LDAP://CN=" & strUserCN & "," & strOU)
    
    If oIADSUser Is Nothing Then
        WScript.Echo "Something's f***ed up... You've got a loop!"
    Else
        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>FUSD User " & strFirstLast & " was added and their Exchange mailbox was created successfully!</li>

"
        WScript.Sleep 333
    End If
                
    Set oMailBox = oIADSUser
    oMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC) 'create a mailbox in a particular store.

    oIADSUser.SetInfo
End Function

Function fixAttribs(strUserCN)
    objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>Modifying found user's attributes...</li>

"
    WScript.Sleep 333

    strBase   =  "<ldap:>;"
    strFilter = "(&(objectclass=user)(cn=" & strUserCN & "));" 
    strAttrs  = "DistinguishedName;"
    strScope  = "subtree"
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Provider = "ADsDSOObject"
    objConn.Open "Active Directory Provider"
    Set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
        
    'extract the DN

    strUserDN = objRS.Fields(0).Value
    strEmailAddr = strUserName & strEmailSuffix
    strProfilePath = "\\apscc-shares\Profiles\" & strUserName
    
    strMemberDN = "CN=" & strFirstName & " " & strLastName & "," & strOU
    strObjectDN = strUserDN
    set objUser = GetObject("LDAP://" & strObjectDN)
    intAccValue = 512
    objUser.Put "userAccountControl", intAccValue
    objUser.Put "sAMAccountName", strUserName 
    objUser.Put "userPrincipalName", strUserName & strEmailSuffix
    objUser.Put "givenName", strFirstName   
    objUser.Put "sn", strLastName           
    objUser.Put "displayName", strFirstName & " " & strLastName 
    objUser.Put "msExchQueryBaseDN", strGlobalAddrBook 'ADD DEFAULT GLOBAL ADDRESS BOOK

    objUser.Put "msExchUseOAB", strOABDN  'ADD DEFAULT OFFLINE ADDRESS BOOK

    objUser.Put "description", strDesc3    'ADD JOB TITLE

    objUser.Put "physicalDeliveryOfficeName", strDesc3    'ADD Location

    objUser.Put "profilePath", strProfilePath    'add roaming profile

    objUser.Put "scriptPath", strScript        'add logon script

    objUser.SetInfo
    
    'SETS FUSD EXCH USER

    Set objGroup = GetObject("LDAP://" & strGroupDN)
    objGroup.Add("LDAP://" & strUserDN)
    
    ' ALLOW FEA TO SEND MAIL TO EVERYONE

    Set objGroup = GetObject("LDAP://" & strFeaDN)
    objGroup.Add("LDAP://" & strMemberDN)    
    
    'SETS SCHOOL AFFILIATION

    Set objGroup = GetObject("LDAP://CN=" & strAdtlGrp & "," & strOU)
    objGroup.Add("LDAP://" & strMemberDN)
    
    If intMessage = vbYes Or intMessage2 = vbYes Then
        'SETS SIRS Access

        Set objGroup = GetObject("LDAP://CN=" & strAdtlGrp2 & ",OU=SIRS GROUPS," & strOU)
        objGroup.Add("LDAP://" & strMemberDN)
    End If     
End Function

strFirstName = InputBox("Please enter the user's FIRST NAME.","First Name?")
strLastName = InputBox("Please enter the user's LAST NAME.","Last Name?")
strFirstLast = strFirstName & " " & strLastName
        
Call schlCode() 'get user's school code


If strDesc2 <> "warehouse" And strDesc2 <> "trans" And strDesc2 <> "tech" And strDesc2 <> "admin" Then
    intMessage = MsgBox("Will this user have SIRS Access to "& strDesc3 & "?", vbYesNo, "SIRS Access?")
Else
    intMessage2 = MsgBox("Do you wish to grant SIRS access to a school?", vbYesNo, "SIRS Access?")
    If intMessage2 = vbYes Then
        Call schlCode2() 'get SIRS school access

    End If 
End If

Set objExplorer = CreateObject("InternetExplorer.Application")
    objExplorer.Navigate "about:blank"   
    objExplorer.ToolBar = 0
    objExplorer.StatusBar = 1
    objExplorer.Width = 550
    objExplorer.Height = 400 
    objExplorer.Visible = 1             
    objExplorer.Document.Title = "Exchange User Creation Tool " & strVersion
    objExplorer.Document.Body.InnerHTML = "</ldap:></ldap:></ldap:></ldap:></ldap:>

<ul>"

    'start by looking for user in FUSD-EXCH OU

    If searchUser(strFirstLast,strOU) = 0 Then
        If strUserExists = "Yes" Then
            strQuery = "strFirstLast"
            strUserFound = "Local"
        Else
            'user not in FUSD-EXCH OU

            If searchUser(strFirstLast,strSirsDN) = 0 Then
                If strUserExists = "Yes" Then
                    strQuery = "strFirstLast"
                    strUserFound = "Sirs"
                Else
                                                    
                End If 'strUserExists = "Yes" (sIRS)

            Else
                'there was en error

                WScript.Echo "Function searchUser(" & strFirstLast & "," & strSirsDN & ") Returned -1"
            End If 'searchUser(strFirstLast,strSirsDN) = 0

            
        End If 'strUserExists = "Yes" (Local)

    
    Else
        'error occurred    

        WScript.Echo "Function searchUser(" & strFirstLast & "," & strOU & ") Returned -1"
        
    End If 'searchUser(strFirstLast,strOU) = 0


'try with username

If strQuery = "" Then
    'start by looking for userName in FUSD-EXCH OU

    If searchUser(strUserName,strOU) = 0 Then
        If strUserExists = "Yes" Then
            strQuery = "strUserName"
            strUserFound = "Local"
        Else
            'userName not in FUSD-EXCH OU

            If searchUser(strUserName,strSirsDN) = 0 Then
                If strUserExists = "Yes" Then
                    strQuery = "strUserName"
                    strUserFound = "Sirs"
                Else
    
                End If 'strUserExists = "Yes" (sIRS)

            Else
                'there was en error

                WScript.Echo "Function searchUser(" & strUserName & "," & strSirsDN & ") Returned -1"
            End If 'searchUser(strFirstLast,strSirsDN) = 0

            
        End If 'strUserExists = "Yes" (Local)

    
    Else
        'error occurred    

        WScript.Echo "Function searchUser(" & strUserName & "," & strOU & ") Returned -1"
        
    End If 'searchUser(strFirstLast,strOU) = 0

End If 'strQuery = ""


If strQuery = "" Then 'nobody home by either CN -- create a user

        Call searchSamName(strUserName)
        
        intUser = 0
        While strSamNameClear = "No"
            Call incName(strUserName,intUser)
            Call searchSamName(strSamNew)
        Wend
    
        If strSamNew = "" Then
        Else
            strUserName = strSamNew
            WScript.Echo "User: " & strFirstLast & " was created, but their user account " & vbCrLf & _
                         "          had to have a number appended to it." & vbCrLf & " " & vbCrLf & "UserName: " & _
                strUserName & strEmailSuffix & vbCrLf & vbCrLf & "Email Address: " & strUserName & strEmailSuffix & _
                vbCrLf & vbCrLf & "Password: '!Password'. Please remind the user to change their" & _
                vbCrLf & "                    password when they login." & vbCrLf & "An email has been sent to accounts@fusd1.org as record."
            Call sendMail()
        End If 
        
        If createUser(strFirstName,strLastName,strFirstLast,strUsername,strPass,strDesc3) = 0 Then
            If createMailbox(strFirstLast) = 0 Then
            
            Else
                'error occured

                WScript.Echo "Function createMailbox(" & strFirstLast & ") Returned -1"
                
            End If 'createMailbox(strFirstLast) = 0

        
        Else
            'error occured

            WScript.Echo "createUser(" & strFirstName & "," & strLastName & "," & strUsername & "," & strPass & "," & strDesc3 & ") Returned -1"
            
        End If 'Function createUser(strFirstName,strLastName,strFirstLast,strUsername,strPass,strDesc3) = 0

End If 'strQuery = "" Then 'nobody home by either CN -- create a user


If strUserExists = "Yes" Then
    Select Case strUserFound
        Case "Local"
            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User already exists!</li>"
            
        Case "Sirs"    
            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User was found in SIRS OU!</li>"
            
            'by which name was the user found

            Select Case strQuery
                Case "strFirstLast"
                
                    If moveUser(strFirstLast,strSirsDN) = 0 Then
                        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strFirstLast & " was moved to the FUSD-EXCH OU!</li>"
                    Else
                        'error occured

                        WScript.Echo "Function moveUser(" & strFirstLast & "," & strSirsDN & ") Returned -1"    
                    End If 'moveUser(strFirstLast,strSirsDN) = 0

                    
                    If hasMailbox("CN=" & strFirstLast & "," & strOU) = 0 Then
                        If strMailboxExist = "Yes" Then
                            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strFirstLast & " already has an Exchange Mailbox!</li>"
                        Else
                        
                            If createMailbox(strFirstLast) = 0 Then
                                objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strFirstLast & "'s mailbox was created sucessfully!</li>"
    
                            Else
                                'error occured

                                WScript.Echo "Function createMailbox(" & strFirstLast & ") Returned -1"
                                
                            End If 'createMailbox(strFirstLast) = 0

                            
                        End If 'strMailboxExist = "Yes"

                        
                    Else
                        'error occured

                        WScript.Echo "Function hasMailbox(CN=" & strFirstLast & "," & strOU & ") Returned -1"
                        
                    End If 'hasMailbox("CN=" & strFirstLast & "," & strOU) = 0

                    
                    If fixAttribs(strFirstLast) = 0 Then
                        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strFirstLast & "'s attributes were modified sucessfully!</li>"
                    Else
                        'error occured

                        WScript.Echo "Function fixAttribs(" & strFirstLast & ") Returned -1"
                    End If 'fixAttribs(strFirstLast) = 0

                    
                Case "strUserName"
                    
                    If moveUser(strUserName,strSirsDN) = 0 Then
                        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strUserName & " was moved to the FUSD-EXCH OU!</li>"
                    Else
                        'error occured

                        WScript.Echo "Function moveUser(" & strFirstLast & "," & strSirsDN & ") Returned -1"    
                    End If 'moveUser(strUserName,strSirsDN) = 0

                    
                    If hasMailbox("CN=" & strUserName & "," & strOU) = 0 Then
                        If strMailboxExist = "Yes" Then
                            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strUserName & " already has an Exchange Mailbox!</li>"
                        Else
                        
                            If createMailbox(strUserName) = 0 Then
                                objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strUserName & "'s mailbox was created sucessfully!</li>"
    
                            Else
                                'error occured

                                WScript.Echo "Function createMailbox(" & strUserName & ") Returned -1"
                                
                            End If 'createMailbox(strUserName) = 0

                            
                        End If 'strMailboxExist = "Yes"

                        
                    Else
                        'error occured

                        WScript.Echo "Function hasMailbox(CN=" & strUserName & "," & strOU & ") Returned -1"
                        
                    End If 'hasMailbox("CN=" & strUserName & "," & strOU) = 0

                    
                    If fixAttribs(strUserName) = 0 Then
                        objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>User: " & strUserName & "'s attributes were modified sucessfully!</li>"
                    Else
                        'error occured

                        WScript.Echo "Function fixAttribs(" & strUserName & ") Returned -1"
                    End If 'fixAttribs(strFirstLast) = 0

                    
            End Select 
            
      
        
        Case Else
            objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "<li>Consider buying a debugger.... Select Case strUserFound =(Gibberish)....</li>"
            WScript.Quit(666)   
    End Select
    
End If

'+++++++++++++++++++++++++++++++++++++++++++++++

objExplorer.Document.Body.InnerHTML = objExplorer.Document.Body.InnerHTML & "</ul>

"
objExplorer.StatusText = "Account Maintenance Complete!"
WScript.Sleep 5000
objExplorer.Quit
WScript.Quit(0)
Points of Interest

Takes user creation (in our situation) from a 5-7 min. process down to 10-15 seconds.
This was my first endeavor into VBScript.
History

Version 1.5.5 Uploaded 5-24-07
License

This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.
A list of licenses authors might use can be found here