Setting targetaddress with vbscript for Exchange 2003

This blog describes how to set the target address attribut via a vb script in an Exchange 2003 organization.

First of all an Input file is needed to read the userlist. Targetaddress.csv is the file name used in the script below. The following two entries are the only attributes which are used.

LegacyExchangeDN,mail.. From the mail attribut value everything is stripped of after the @ and replaced with then this string is put into targetaddress with the

A log file is also created in the directory where the script is called. The filename of the log file is logging_set_targetaddress.txt

First the script reads the Input file targetaddress.csv. Then it tries to find the user with the E-Mail address of the value "mail".

In case the result is not equal 1 the script will do nothing and will write an error in the log file.


Please note that this script is just an example script and needs to be adapted

------------------- ------------------------------------------------------------------------------------

 ------------------- Start of script ----------------------------------------------------------------------

Option Explicit
Const ForWriting = 2, ForAppending = 8, ForReading = 1
Const CreateIfNotExist = True
Const DoNotCreate = False

Dim FSO, file, Benutzer
Dim TextZeile, data
Dim rootDSE
Dim conn, Email, LDAPStr, Mystring, vpathfichout, strDomain, objCommand
Dim oPerson, domainname, objRoot, username, cn, cmd, rs, strXSMTPContainer, strX500Container, strAddrPrefix, strSMTPPrefix, pre, dummy,dummy1

vpathfichout = "logging_set_targetaddress.txt"

WritetoFile vpathfichout, " Skript gestartet am: " & Date() & " " & Time()

Set FSO=CreateObject("Scripting.FileSystemObject")
Set file = FSO.OpenTextFile("targetaddress.csv", ForReading, False)

strSMTPPrefix ="SMTP:"

if domainname = "" then
 set objRoot = getobject("LDAP://RootDSE")
 domainname = objRoot.get("defaultNamingContext")
end if

TextZeile=file.Readline()  ' Einlesen der Headerzeile

while not file.AtEndOfStream
  If IsNull(TextZeile) Then
  End If
     'wscript.echo Benutzer(0) & ";" & Benutzer(1)
     username = Benutzer(1)
     If username <> "" then
   wscript.echo finduser (username,domainname)
 End if
WritetoFile vpathfichout, " Skript beendet am: " & Date() & " " & Time()

Function FindUser(Byval UserName, Byval Domain) 

 set cn = createobject("ADODB.Connection")
 set cmd = createobject("ADODB.Command")
 set rs = createobject("ADODB.Recordset") "Provider=ADsDSOObject;"
 cmd.commandtext="SELECT ADsPath FROM 'LDAP://" & Domain & _
    "' WHERE mail = '" & UserName & "'"
 set rs = cmd.execute

 if err<>0 then
  FindUser="Error connecting to Active Directory Database:" & err.Description
  WritetoFile vpathfichout, "Error connecting to Active Directory Database:" & err.Description
  if not rs.BOF and not rs.EOF then
   Set oPerson = GetObject(rs.Fields(0).Value)
   strXSMTPContainer= Benutzer(1)
   dummy1= Split(strXSMTPContainer,"@",-1,1)

   dummy = dummy1(0) & ""
   wscript.echo "Routingadresse: " & dummy

   oPerson.PutEx 3, "targetAddress", Array(strSMTPPrefix & dummy)
   wscript.echo err.number & err.description

   'wscript.echo "Hinzufügen von targetaddress : " & strSMTPPrefix  & strXSMTPContainer
   WritetoFile vpathfichout, "Hinzufügen von " & strSMTPPrefix  & " " & strXSMTPContainer
   strXSMTPContainer =""
       FindUser = rs(0)
   FindUser = Benutzer(1) & " Nicht gefunden"
   WritetoFile vpathfichout, Benutzer(1) & " Nicht gefunden"
  end if
 end if
end Function

Sub WritetoFile (FilePathName, Data)
Dim Log
Dim fs
 Set fs = CreateObject("Scripting.FileSystemObject")
 Set Log = fs.OpenTextFile(FilePathName, ForAppending, CreateIfNotExist)
 Log.Writeline data
end Sub

 ------------------- End of script ----------------------------------------------------------------------

Save the script example as yourfilename.vbs

Start the script with the following command: cscript yourfilename.vbs

Comments (0)

Skip to main content