?
Solved

Exchange forward code need help

Posted on 2011-09-13
13
Medium Priority
?
293 Views
Last Modified: 2012-05-12
Hi,

Exchange forward code need help
Code from Rob works great but need the forward checkbox selected as it sets the forward

Can anyone help Forward
'=======================
strInputFile = "EmailForwards.txt"

Const intForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)

While Not objInputFile.AtEndOfStream
      strIntUserADsPath = ""
      strExtUserDN = ""
      arrAddresses = Split(objInputFile.ReadLine, ";")
      strInternalEmail = arrAddresses(0)
      strExternalEmail = arrAddresses(1)
      strIntUserADsPath = Get_LDAP_User_Properties("user", "mail", strInternalEmail, "ADsPath")
      If InStr(strIntUserADsPath, "LDAP://") > 0 Then
            strExtUserADsPath = Get_LDAP_User_Properties("contact", "mail", strExternalEmail, "ADsPath")
            If InStr(strExtUserADsPath, "LDAP://") > 0 Then
                  Set objIntUser = GetObject(strIntUserADsPath)
                   'objIntUser.Put "AltRecipient", Replace(strExtUserDN, "LDAP://", "")
                  ' OR MAYBE ALSO
                  objIntUser.Put "AltRecipient", Replace(strExtUserADsPath, "LDAP://", "")

                 objIntUser.SetInfo
            Else
                  MsgBox "Could not find an external contact with an email address of " & strExternalMail
            End If
      Else
            MsgBox "Could not find an internal user account with an email address of " & strInternalEmail
      End If
Wend

objInputFile.Close
Set objInputFile = Nothing
Set objFSO = Nothing

MsgBox "Finished."

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      ' This is a custom function that connects to the Active Directory, and returns the specific
      ' Active Directory attribute value, of a specific Object.
      ' strObjectType: usually "User" or "Computer"
      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
      '                        It filters the results by the value of strObjectToGet
      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
      '                        For example, if you are searching based on the user account name, strSearchField
      '                        would be "samAccountName", and strObjectToGet would be that speicific account name,
      '                        such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
      '      strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
      '                        the home folder path, as defined by the AD, for a specific user, this would be
      '                        "homeDirectory".  If you want to return the ADsPath so that you can bind to that
      '                        user and get your own parameters from them, then use "ADsPath" as a return string,
      '                        then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
      
      ' Now we're checking if the user account passed may have a domain already specified,
      ' in which case we connect to that domain in AD, instead of the default one.
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
      ' Otherwise we just connect to the default domain
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("DefaultNamingContext")
            'strDNSDomain = objRootDSE.Get("RootDomainNamingContext")
      End If

      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection

 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")

      ' Construct the LDAP syntax query.
      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
      adoCommand.CommandText = strQuery
      ' Define the maximum records to return
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False

      MsgBox strQuery
      ' Run the query.
      Set adoRecordset = adoCommand.Execute
      ' Enumerate the resulting recordset.
      strReturnVal = ""
      Do Until adoRecordset.EOF
          ' Retrieve values and display.    
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strReturnVal = "" Then
                      strReturnVal = adoRecordset.Fields(intCount).Value
                Else
                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop

      ' Clean up.
      adoRecordset.Close
      adoConnection.Close
      Get_LDAP_User_Properties = strReturnVal

End Function
'=======================

Open in new window

0
Comment
Question by:bsharath
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 5
13 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 36533772
Hi Sharath,

Try changing this:
                 objIntUser.SetInfo

To this:
                 objIntUser.deliverAndRedirect = True
                 objIntUser.SetInfo

Regards,

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 36533891
Perfect thanks Rob
One more addition
After setting this i want the Contact moved to another OU
Also now i get popup's need to disable that and get success and failure report
0
 
LVL 11

Author Comment

by:bsharath
ID: 36533961
Hi Rob any help...
Need to do few 1,000 now.. :-)
0
Create CentOS 7 Newton Packstack Running Keystone

A bug was filed against RDO for the installation of Keystone v3. This guide is designed to walk you through the configuration for using Keystone v3 with Packstack. You will accomplish this using various repos and the Answers file.

 
LVL 65

Expert Comment

by:RobSampson
ID: 36533978
OK, try this.  If you don't want the last "Finished" message, just comment it out.

Regards,

Rob.
'=======================
strInputFile = "EmailForwards.txt"
strNewOU = "OU=NewContacts,DC=Domain,DC=Com"
strLogFile = "EmailForwardsLog.txt"

Const intForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Set objOU = GetObject("LDAP://" & strNewOU)

Set objLog = objFSO.CreateTextFile(strLogFile, True)
objLog.WriteLine "Emails forwards script running " & Now
objLog.WriteLine "Moving accounts to " & strNewOU & vbCrLf

While Not objInputFile.AtEndOfStream
	strIntUserADsPath = ""
	strExtUserDN = ""
	arrAddresses = Split(objInputFile.ReadLine, ";")
	strInternalEmail = arrAddresses(0)
	strExternalEmail = arrAddresses(1)
	strIntUserADsPath = Get_LDAP_User_Properties("user", "mail", strInternalEmail, "ADsPath")
	If InStr(strIntUserADsPath, "LDAP://") > 0 Then
		strExtUserADsPath = Get_LDAP_User_Properties("contact", "mail", strExternalEmail, "ADsPath")
		If InStr(strExtUserADsPath, "LDAP://") > 0 Then
			Set objIntUser = GetObject(strIntUserADsPath)
			'objIntUser.Put "AltRecipient", Replace(strExtUserDN, "LDAP://", "")
			' OR MAYBE ALSO
			objIntUser.Put "AltRecipient", Replace(strExtUserADsPath, "LDAP://", "")
			objIntUser.deliverAndRedirect = True
			On Error Resume Next
			objIntUser.SetInfo
			If Err.Number = 0 Then
				objLog.WriteLine "Successfully set attributes for " & objIntUser.DisplayName
				intReturn = objOU.MoveHere(strADsPath, vbNullString)
				If intReturn = 0 Then
					objLog.WriteLine objIntUser & " moved to " & strNewOU
				Else
					objLog.WriteLine "Failed to move " & objIntUser & " to " & strNewOU
				End If
			Else
				objLog.WriteLine "Failed to set attributes for " & objIntUser.DisplayName & ". Error " & Err.Number & ": " & Err.Description
			End If
			Err.Clear
			On Error Goto 0
		Else
			'MsgBox "Could not find an external contact with an email address of " & strExternalMail
			objLog.WriteLine "Could not find an external contact with an email address of " & strExternalMail
		End If
	Else
		'MsgBox "Could not find an internal user account with an email address of " & strInternalEmail
		objLog.WriteLine "Could not find an internal user account with an email address of " & strInternalEmail
	End If
Wend

objInputFile.Close
objLog.Close
Set objInputFile = Nothing
Set objFSO = Nothing

WScript.Echo "Finished. Please see " & strLogFile

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      ' This is a custom function that connects to the Active Directory, and returns the specific
      ' Active Directory attribute value, of a specific Object.
      ' strObjectType: usually "User" or "Computer"
      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
      '                        It filters the results by the value of strObjectToGet
      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
      '                        For example, if you are searching based on the user account name, strSearchField
      '                        would be "samAccountName", and strObjectToGet would be that speicific account name,
      '                        such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
      '      strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
      '                        the home folder path, as defined by the AD, for a specific user, this would be
      '                        "homeDirectory".  If you want to return the ADsPath so that you can bind to that
      '                        user and get your own parameters from them, then use "ADsPath" as a return string,
      '                        then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
      
      ' Now we're checking if the user account passed may have a domain already specified,
      ' in which case we connect to that domain in AD, instead of the default one.
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
      ' Otherwise we just connect to the default domain
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("DefaultNamingContext")
            'strDNSDomain = objRootDSE.Get("RootDomainNamingContext")
      End If

      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection

 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")

      ' Construct the LDAP syntax query.
      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
      adoCommand.CommandText = strQuery
      ' Define the maximum records to return
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False

      MsgBox strQuery
      ' Run the query.
      Set adoRecordset = adoCommand.Execute
      ' Enumerate the resulting recordset.
      strReturnVal = ""
      Do Until adoRecordset.EOF
          ' Retrieve values and display.    
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strReturnVal = "" Then
                      strReturnVal = adoRecordset.Fields(intCount).Value
                Else
                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop

      ' Clean up.
      adoRecordset.Close
      adoConnection.Close
      Get_LDAP_User_Properties = strReturnVal

End Function
'=======================

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 36534344
Rob i get this


---------------------------
Windows Script Host
---------------------------
Script:      D:\Set Forwards.vbs
Line:      22
Char:      2
Error:      Subscript out of range: '[number: 1]'
Code:      800A0009
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------

Also i still get the msg boxes and does not move to the new OU
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 36534965
That's a very odd error to have at that point......is the data in the file valid?

I think it might be this line that has the error:
      strExternalEmail = arrAddresses(1)

which suggests there's a line in the file without the semi-colon and an external email address.

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 36535011
Thanks Rob it works. Now just the move does not work
0
 
LVL 11

Author Comment

by:bsharath
ID: 36535160
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 36535187
Oh, change
                        intReturn = objOU.MoveHere(strADsPath, vbNullString)
to
                        intReturn = objOU.MoveHere(strIntUserADsPath, vbNullString)

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 36535197
Rob i think this is moving users i want the contacts moved
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 36535294
Oh, is that this then?

                        intReturn = objOU.MoveHere(strExtUserADsPath, vbNullString)

Rob.
0
 
LVL 11

Author Comment

by:bsharath
ID: 36540457
0
 
LVL 11

Author Comment

by:bsharath
ID: 36565343
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
The Windows functions GetTickCount and timeGetTime retrieve the number of milliseconds since the system was started. However, the value is stored in a DWORD, which means that it wraps around to zero every 49.7 days. This article shows how to solve t…
The goal of the tutorial is to teach the user how to use functions in C++. The video will cover how to define functions, how to call functions and how to create functions prototypes. Microsoft Visual C++ 2010 Express will be used as a text editor an…
The goal of the video will be to teach the user the concept of local variables and scope. An example of a locally defined variable will be given as well as an explanation of what scope is in C++. The local variable and concept of scope will be relat…
Suggested Courses

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question