VB Script to set email in active directory

Clarifications

I've only used it on SBS 2003. Check the link to Guy's site as he may have updated information.

I normally use Guy Thomas's scripts as they are easy to understand and as long as the users have an account in Active Directory and they are in the specified OU they will get a Mailbox. Modify the below text to suit.

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

 AddMailbox.vbs
' VBScript to add mailboxes to existing users
' Author Guy Thomas http://computerperformance.co.uk/
' Version 2.6 - April 8th 2005
Option Explicit
Dim ADOcon ' ADODB.ADOconnection
Dim command ' ADODB.Command
Dim rs ' ADODB.Recordset
Dim objPerson ' CDO.Person
Dim mbox ' CDOEXM.IMailboxStore interface
Dim iMsg ' CDO.Message
Dim intMailbox ' Increment the number of mailboxes created

strServer = "fs2003" ' Name of the File Server
strExchangeOrg = "MINERO"  ' Domain Name
strDomain = "DC=MINERO,DC=LOCAL" 
strOU = "OU=SBSUsers"  ' Container for the users that will get a Mailbox 
strAdminGroup = "First Administrative Group"
strStorageGroup = "First Storage Group"
strStoreName = "Mailbox Store (" & strServer & ")"

' Build LDAP string
strMailbox = strMailbox & "CN=" & strStoreName
strMailbox = strMailbox & ",CN=" & strStorageGroup
strMailbox = strMailbox & ",CN=InformationStore"
strMailbox = strMailbox & ",CN=" & strServer
strMailbox = strMailbox & ",CN=Servers"
strMailbox = strMailbox & ",CN=" & strAdminGroup
strMailbox = strMailbox & ",CN=Administrative Groups"
strMailbox = strMailbox & ",CN=" + strExchangeOrg
strMailbox = strMailbox & ",CN=Microsoft Exchange"
strMailbox = strMailbox & ",CN=Services"
strMailbox = strMailbox & ",CN=Configuration"
strMailbox = strMailbox & "," & strDomain

' Create the ADODB.ADOconnection and ADOconnect to Active Directory
Set ADOcon = CreateObject("ADODB.connection")
ADOcon.Provider = "ADsDSOObject"

' Create and configure the ADODB.Command
Set command = CreateObject("ADODB.Command")
ADOcon.Open
Set command.Activeconnection = ADOcon

' Select all properties of users from a given organizational group
command.CommandText = "SELECT * FROM 'LDAP://" & strOU & "," _
& strDomain & "' WHERE objectClass = 'user'"

' Execute the ADODB.Command and store the results in the ADODB.Recordset
Set rs = command.Execute

' Preparing the mailbox
Set objPerson = CreateObject("CDO.Person")

' Loop through the users
intMailbox = 0
While Not rs.EOF
' Open each CDO.Person using the location information specified by the ADsPath property
objPerson.DataSource.Open (rs.Fields("ADsPath").Value), , 3
' Get the IMailboxStore interface to the users mailbox
Set mbox = objPerson.GetInterface("IMailboxStore")

'Test if the mailbox already exists
If mbox.HomeMDB = "" Then
     ' If the mailbox does not exist, create it

      mbox.CreateMailbox strMailbox
      intMailbox = intMailbox + 1
      ' Set the Email property of the Person to the new mailbox
      strEmail = objPerson.Fields("sAMAccountName").Value & "@CPEXCH.COM"
      objPerson.Email = strEmail
      objPerson.Fields.Update
      objPerson.DataSource.Save

          ' Create a message to initialize the mailbox
          Set iMsg = CreateObject("CDO.Message")

          with iMsg
             .To = strEmail
             .From = "administrator@minero.local"
             .Subject = "Welcome to your new mailbox!"
             .TextBody = "Note your new email address: " & strEmail
             .Send
         End With

         Set iMsg = Nothing
End If
'Move to the next record
rs.MoveNext
Wend
WScript.Echo intMailbox & " mailboxes were created."

WScript.Quit

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

bump