ModifyUserForwardTo.vbs

'=========================================================================
' ModifyUserForwardTo.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: [email protected]
' WEB: https://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: In AD the altRecipient Attribute aka Forward To, is the Email
' Address a User's Email Forwards to.
'
' strUserPath: ADsPath or distinguishedName of the User You Want to Modify the
' Email Forwarding On. This can Also Be an Organization Unit/Container If You
' Want to Bulk Modify Users to Have Their Email Forwarded to the Same User/Contact.
'
' strFwdPath: ADsPath or distinguishedName of the User/Contact You Want Emails
' to Forward To.
'
' blnFwdCopy: This Value Must be True/False. True Delivers a Copy to Both The
' Forwarding Address and Keeps a Copy in the Mailbox. False Just Forwards the
' Email.
'
' The Function Will Return the Result, Users ADsPath, Whether the Forward Was
' Set to Send a Copy to Both, The New ForwardTo ADsPath, and Whether the Copy is
' Sent to Both User's ADsPath, User's Email, altRecipient User/Contact ADsPath, and the
' altRecipient Email.
' EXAMPLE: Modify Jim Smith To Forward Their Email to John Doe
'          strUserPath = "LDAP://CN=Jim Smith,CN=Users,DC=domain,DC=com"
'          strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
'          blnFwdCopy = False
' EXAMPLE: Modify Jim Smith To Forward Their Email to John Doe and Keep a Copy In Jim's Mailbox
'          strUserPath = "LDAP://CN=Jim Smith,CN=Users,DC=domain,DC=com"
'          strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
'          blnFwdCopy = False
' EXAMPLE: Bulk Modify Users to Forward Their Email to John Doe
'          strUserPath = "LDAP://CN=Users,DC=domain,DC=com"
'          strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
'          blnFwdCopy = False
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strUserPath: strUserPath = "LDAP://CN=Jim Smith,CN=Users,DC=domain,DC=com"
Dim strFwdPath: strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
Dim blnFwdCopy: blnFwdCopy = True
' ------ END CONFIGURATION ------

Call Logger("ModifyUserForwardTo.txt", "RESULT  USER    FWDTO   FWDCOPY NEWFWDTO    FWDCOPY", True)
Call Logger("ModifyUserForwardTo.txt", ModifyUserForwardTo(strUserPath,strFwdPath,blnFwdCopy), False)
Wscript.Echo "Finished It"

Private Function ModifyUserForwardTo(userPath, fwdPath, blnFwdCopy)

    On Error Resume Next

    userPath = Replace(userPath,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    fwdPath = Replace(fwdPath,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")
    Dim objCommand: Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default
    Const ADS_SCOPE_SUBTREE = 2
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
    objCommand.CommandText = "SELECT ADsPath, altRecipient, deliverAndRedirect FROM 'LDAP://" & userPath & "'WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Dim objUser, strTemp
    Do Until objRecordSet.EOF
        ' Log Original altRecipient Values
        If IsNull(objRecordSet.Fields("altRecipient").Value) Then
            strTemp = objRecordSet.Fields("ADsPath").Value & vbTab & "N/A" & vbTab & "N/A"
        Else
            strTemp = objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("altRecipient").Value & vbTab & objRecordSet.Fields("deliverAndRedirect").Value
        End If

        ' Modify altRecipient Values
        Set objUser = GetObject(objRecordSet.Fields("ADsPath").Value)
        objUser.altRecipient = fwdPath
        If blnFwdCopy = True Then
            objUser.deliverAndRedirect = True
        End If
        strTemp = strTemp & vbTab & fwdPath & vbTab & blnFwdCopy
        objUser.SetInfo

        ' Error Check
        If Err.Number <> 0 Then
            Err.Clear
            strTemp = "!~ERROR~!" & vbTab & strTemp & vbCrLf
        Else
            strTemp = "SUCCESS" & vbTab & strTemp & vbCrLf
        End If
        strResult = strTemp
        objRecordSet.MoveNext
    Loop

    ModifyUserForwardTo = strResult

    On Error Goto 0

End Function

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub