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