ListUserForwardTo.vbs

'=========================================================================
' ListUserForwardTo.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.
' Pass the ADsPath or Dinstinguised Name of the User or
' Container/Organizational Unit to the Function, Which Will List the
' User's ADsPath, User's Email, altRecipient User/Contact ADsPath, and the
' altRecipient Email.
' EXAMPLE: strUserPath = "LDAP://CN=Users,DC=domain,DC=com"
'          strUserPath = "CN=Users,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strUserPath: strUserPath = "LDAP://CN=Users,DC=domain,DC=com"
' ------ END CONFIGURATION ------
Call Logger("ListUserForwardTo.txt", "USER  USEREMAIL   ALTRECIPIENT    ALTRECIPIENTEMAIL   FWDCOPY", True)
Call Logger("ListUserForwardTo.txt", ListUserForwardTo(strUserPath), False)
Wscript.Echo "Finished"

Private Function ListUserForwardTo(userPath)

    On Error Resume Next

    userPath = Replace(userPath,"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, mail, altRecipient, deliverAndRedirect FROM 'LDAP://" & userPath & "' WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Dim objFwd
    Do Until objRecordSet.EOF
        If IsNull(objRecordSet.Fields("altRecipient").Value) Then
            strResult = strResult & objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("mail").Value & vbTab & "N/A" & vbTab & "N/A" & vbCrLf
        Else
            Set objFwd = GetObject("LDAP://" & objRecordSet.Fields("altRecipient").Value)
            strResult = strResult & objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("mail").Value & vbTab & "LDAP://" & objRecordSet.Fields("altRecipient").Value & vbTab & objFwd.mail & vbTab & "DeliverBoth:" & objRecordSet.Fields("deliverAndRedirect").Value & vbCrLf
            Set objFwd = Nothing
        End If
        objRecordSet.MoveNext
    Loop

    ListUserForwardTo = 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