'=========================================================================
' ListUserForwardTo.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' 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
