Moving a SunOS sendmail box to Microsoft Exchange 2003.

Mitigating factors: Active Directory has been used for 8+ years for ASP/ASP.net web application.  There are some (about half) duplicate users in both directory systems, and some dead/ghosted users in both directories.

Few users keep mailboxes on the box, so I haven't bothered with *NIX migration utils from Microsoft.

Here's the situation... I've moved over 5 testbed users over to Exchange.  So now, I have two MXes both handling @chem.queensu.ca.  My Exchange system POPs email from the SunOS box.  But now all my Exchange users can't send mail to users on the old system.

Solution?  Add @old.chem.queensu.ca to SunOS mailboxes, establish mailboxes for live users from SunOS system on the Exchange box, create "external" contacts and forward mail.

How do you get VBScripts to manipulate Active Directory objects?  Add an email address, establish an Exchange mailbox, and setup forwarders, all based off a passwd file?

Just hacked up a little script.  It goes through all users in an OU, compares to a passwd file from SendMail, and faithfully creates contacts to the username@old.chem.queensu.ca and sets the Exchange-side user to forward to that address.

I've set my Exchange to smarthost mail thru the SunOS box, so my mail to 'old' users will continue to function without DNS modification.

Thanks to Aidan for helping me with this one =)

(easily modified... note that my 'imported' users on Exchange are lacking EVERYTHING except for an email address and given name.  I'm going to be running a full audit and recreating ALL users - hence the hack.)

Dim MDBName
Dim StorageGroup
Dim Server
Dim AdminGroup
Dim Organization
Dim DomainDN

MDBName = "Mailbox Store (EMAIL2003)"
StorageGroup = "First Storage Group"
Server = "email2003"
AdminGroup = "First Administrative Group"
Organization = "Chernoff 2005"
DomainDN = "DC=domain,DC=chem,DC=queensu,DC=ca"

Function CreateMailbox(objuser)
 Set objMailbox = objUser

        objMailbox.CreateMailbox "LDAP://CN=" & MDBName & _
                               ",CN=" & StorageGroup & _
                               ",CN=InformationStore" & _
                               ",CN=" & Server & _
                               ",CN=Servers" & _
                               ",CN=" & AdminGroup & _
                               ",CN=Administrative Groups" & _
                               ",CN=" & Organization & _
                               ",CN=Microsoft Exchange,CN=Services" & _
                               ",CN=Configuration," & DomainDN
 objUser.SetInfo
End Function

Function FileToArray(ByVal strFile, ByVal blnUNICODE)
 Const FOR_READING = 1
 Dim objFSO, objTS, strContents
 FileToArray = Split("")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 If objFSO.FileExists(strFile) Then
  On Error Resume Next
  Set objTS = objFSO.OpenTextFile(strFile, FOR_READING, False, blnUNICODE)
  If Err = 0 Then
   strContents = objTS.ReadAll
   objTS.Close
   FileToArray = Split(strContents, vbNewLine)
  End If
 End If
End Function

Function CreateForward(User)
 firstname = User.sAMAccountName
 lastname = "External Contact"
 email = User.sAMAccountName & "@old.chem.queensu.ca"
 
 Dim contactName
 Dim description
 description = firstname & " " & lastname
 contactName = "CN=" & description
 
 
 Set objContainer = GetObject("LDAP://OU=Grandfathered Users,OU=Network Users,DC=domain,DC=chem,DC=queensu,DC=ca")
 Set objContact = objContainer.Create("contact", contactName)
 objContact.Put "givenName", firstname & " External"
 objContact.Put "sn", lastname
 objContact.Put "displayName", description
 objContact.Put "Description", description
 objContact.Put "Mail", email
 objContact.Put "proxyAddresses", "SMTP:" & email
 objContact.Put "targetAddress", "SMTP:" & email
 objContact.Put "mAPIRecipient", "FALSE"
 objContact.Put "mailNickname", description
 objContact.Put "legacyExchangeDN", "/o=Chernoff 2005/ou=First Administrative Group/cn=Recipients/cn=" & firstname & " " & lastname
 objContact.Put "msExchALObjectVersion", "21"
 objContact.SetInfo

 User.Put "altRecipient", "CN=" & description & ",OU=Grandfathered Users,OU=Network Users,DC=domain,DC=chem,DC=queensu,DC=ca"
 User.SetInfo
End Function

'Set rootDSE = GetObject("LDAP://RootDSE")
'domainContainer = rootDSE.Get("defaultNamingContext")

Set CNUsers = GetObject("LDAP://OU=Grandfathered Users,OU=Network Users,DC=domain,DC=chem,DC=queensu,DC=ca")
CNUsers.Filter = Array("user")

' Create the array of usernames from the passwd file
Dim rawUserNamesArray ' with :::: from passwd
rawUserNamesArray = FileToArray("passwd", False)

' Process the file
For i = 0 to UBound(rawUserNamesArray)
 Dim line
 line = Split(rawUserNamesArray(i), ":")
 rawUserNamesArray(i) = line(0)
Next

Set chemEmailTest = New RegExp
With chemEmailTest
 .Pattern = "@chem.queensu.ca"
 .IgnoreCase = True
 .Global = True
End With

'Set objFSO = CreateObject("Scripting.FileSystemObject")
'Set objTS = objFSO.OpenTextFile("contacts.csv", FOR_READING, False, blnUNICODE)
'objTS.Echo "objectClass,DN,displayName"

For Each User in CNUsers
' WScript.Echo User.sAMAccountName

 ' Are they @chem.queensu.ca?
 If chemEmailTest.Test(User.mail) Then
  ' Are they in the passwd file?
  For Each Username in rawUserNamesArray
   'WScript.Echo Username
   'WScript.Echo User.sAMAccountName
   If Username = User.sAMAccountName Then
    'WScript.Echo Username & " is in both"
    ' Create mailbox
    CreateMailbox(User)

    ' Create forwarder
    'WScript.Echo User.givenName & " " & User.sn & " " & User.SamAccountName
    CreateForward User
   End If
  Next  
 End If
Next

WScript.Echo "Done!"

And also, a little script that returns a list of all users that are in the Exchange in the appropriate domain name, BUT, not in the passwd file.  (aka... Windows/AD ghosted users)

Function FileToArray(ByVal strFile, ByVal blnUNICODE)
 Const FOR_READING = 1
 Dim objFSO, objTS, strContents
 FileToArray = Split("")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 If objFSO.FileExists(strFile) Then
  On Error Resume Next
  Set objTS = objFSO.OpenTextFile(strFile, FOR_READING, False, blnUNICODE)
  If Err = 0 Then
   strContents = objTS.ReadAll
   objTS.Close
   FileToArray = Split(strContents, vbNewLine)
  End If
 End If
End Function

Set CNUsers = GetObject("LDAP://OU=Grandfathered Users,OU=Network Users,DC=domain,DC=chem,DC=queensu,DC=ca")
CNUsers.Filter = Array("user")

' Create the array of usernames from the passwd file
Dim rawUserNamesArray ' with :::: from passwd
rawUserNamesArray = FileToArray("passwd", False)

' Process the file
For i = 0 to UBound(rawUserNamesArray)
 Dim line
 line = Split(rawUserNamesArray(i), ":")
 rawUserNamesArray(i) = line(0)
Next

Set chemEmailTest = New RegExp
With chemEmailTest
 .Pattern = "@chem.queensu.ca"
 .IgnoreCase = True
 .Global = True
End With

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile("out.txt", 2, True, -2)

For Each User in CNUsers
' WScript.Echo User.sAMAccountName

 ' Are they @chem.queensu.ca?
 If chemEmailTest.Test(User.mail) Then
  ' Are they in the passwd file?
  found = False
  For Each Username in rawUserNamesArray
   If Username = User.sAMAccountName Then
    found = true
   End If
  Next
  If Not found Then
   objTS.WriteLine User.sAMAccountName
  End If
 End If
Next

objTS.Close()

WScript.Echo "Done!"