Need help in creating a VBScript to create Exchange mailboxes

I found bits and pieces of code from this site and others on the Internet, combined them, and then customized it to my needs. The script reads data from the attached Excel spreadsheet, creates home folders (if told to), user accounts in Active Directory, and would like for it to create a mailbox if told to. I found code to create mailboxes on the following Web site:

http://www.computerperformance.co.uk/vbscript/vbscript_user_mailbox.htm

but it doesn't seem complete. It looks like more needs to be done than what's in there. Can anyone offer assistance in helping me to complete the mailbox creation portion of this code? As with the existing code, I want to specify in the input file whether a mailbox is to be created and whatever else is needed to create the mailbox. Thank you.
Option Explicit
'On Error Resume Next
Dim strOU, strSheet, strSam, strCN, strLast, strFirst
Dim strPWD, strUPN, strDispName, strDesc, intRow
Dim strServer, strParentFolder, strFullUNCPath, strShareName
Dim strFolderLocalPath, strMakeFolder, strCreateMail
Dim strCompany, strDept, strPhone, strTitle, strOffice
Dim objExcel, objSpread, objUser, objFSO, objShell
 
'Assign values to variables
strOU = "OU=Test Accounts," ' Note the comma
strSheet = "c:\useraccounts2.xls"
strServer = "server"
strParentFolder = "\\" & strServer & "\d$\Users\"
 
Const FS = 0
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
 
' Check to see if spreadsheet exits
If objFSO.FileExists(strSheet) = False Then
  MsgBox("The file " & strSheet & " does not exist. Please create the file and run the script again.")
  WScript.Quit
End If
 
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 3 'Row 1 often contains headings
 
' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet
' Trim function eliminates blank spaces
Do Until objExcel.Cells(intRow,1).Value = ""
   strLast = Trim(objExcel.Cells(intRow, 1).Value)
   strFirst = Trim(objExcel.Cells(intRow, 2).Value)
   strDesc = Trim(objExcel.Cells(intRow, 3).Value)
   strMakeFolder = Trim(objExcel.Cells(intRow, 4).Value)
   strCompany = Trim(objExcel.Cells(intRow, 7).Value)
   strDept = Trim(objExcel.Cells(intRow, 8).Value)
   strPhone = Trim(objExcel.Cells(intRow, 9).Value)
   strCN = Trim(objExcel.Cells(intRow, 11).Value)
   strSam = Trim(objExcel.Cells(intRow, 12).Value)
   strPWD = Trim(objExcel.Cells(intRow, 13).Value)
   strUPN = Trim(objExcel.Cells(intRow, 14).Value)
   strDispName = Trim(objExcel.Cells(intRow, 15).Value)
   strFullUNCPath = strParentFolder & strLast & ", " & strFirst
   strShareName = strSam & "$"
   strFolderLocalPath = "e:\Files\Users\" & strLast & ", " & strFirst
   strTitle = strDesc
   strOffice = strDept
   
   'Call to subroutines
   If strMakeFolder = "Yes" Then
     Call CreateHomeFolder(strServer, strFullUNCPath, _
       strFolderLocalPath, strSam, strShareName, FS)
   End If
   
   Call CreateUserAccount(strSam, strFirst, strLast, strUPN, _
     strDispName, strDesc, strMakeFolder, strOU, strServer, _
       strFolderLocalPath, strCompany, strPhone, strDept, _
         strCN, strPWD, strOffice)
   
   'If strCreateMail = "Yes" Then
   '  CreateMailbox
   'End If
   
   'Increment the row counter
   intRow = intRow + 1
   
Loop
 
'Close Excel
objExcel.Quit
 
'Clean up objects
Set objFSO = Nothing
Set objShell = Nothing
Set objExcel = Nothing
Set objSpread = Nothing
 
'Close the Windows Scripting Host
WScript.Quit
 
'Subroutines Below
'***********************
Sub CreateHomeFolder(strServer, strFullUNCPath, _
  strFolderLocalPath, strSam, strShareName, FS)
 
   If objFSO.FolderExists(strFullUNCPath) = False Then
     objFSO.CreateFolder strFullUNCPath
      
     Dim objWMIService, objNewShare
     Dim errReturn
      
     'this code creates the share
     Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strServer & "\root\cimv2")
     Set objNewShare = objWMIService.Get("Win32_Share")
     errReturn = objNewShare.Create(strFolderLocalPath, strShareName, FS)
         
     Set objWMIService = Nothing
     Set objNewShare = Nothing
     
   End If
 
End Sub
 
Sub CreateUserAccount(strSam, strFirst, strLast, strUPN, _
     strDispName, strDesc, strMakeFolder, strOU, strServer, _
       strFolderLocalPath, strCompany, strPhone, strDept, _
         strCN, strPWD, strOffice)
     
    Dim objRootLDAP, objContainer, objExec
    Dim errReturn, strRemoteExec
     
    ' Bind to Active Directory, Users container.
    Set objRootLDAP = GetObject("LDAP://rootDSE")
    Set objContainer = GetObject("LDAP://" & strOU & _
      objRootLDAP.Get("defaultNamingContext"))
 
   ' Build the actual User from data in strSheet.
   Set objUser = objContainer.Create("User", "cn=" & strCN)
   objUser.sAMAccountName = strSam
   objUser.givenName = strFirst
   objUser.sn = strLast
   objUser.userPrincipalName = strUPN
   objUser.displayName = strDispName
   objUser.description = strDesc
   objUser.company = strCompany
   objUser.department = strDept
   objUser.telephoneNumber = strPhone
   objUser.title = strTitle
   objUser.physicalDeliveryOfficeName = strOffice
   objUser.SetInfo
 
   ' Separate section to enable account with its password
   objUser.userAccountControl = 512
   objUser.pwdLastSet = 0
   objUser.SetPassword strPWD
   objUser.SetInfo
   
   If strMakeFolder = "Yes" Then   
     'this code assigns the necessary NTFS permission
     strRemoteExec = "c:\pstools\psexec \\" & strServer & " -accepteula -i cacls " & """" & strFolderLocalPath & """" & " /e /g " & strSam & ":C"
     Set objExec=objShell.Exec(strRemoteExec)
     errReturn = objExec.StdOut.ReadAll  
     objUser.HomeDirectory = "\\" & strServer & "\" & strSam & "$"
     objUser.HomeDrive = "H:"
     objUser.SetInfo
     
   End If
   
   Set objRootLDAP = Nothing
   Set objContainer = Nothing
   Set objUser = Nothing
   Set objExec = Nothing
 
End Sub
 
'Sub CreateMailbox()
 
'End Sub

Open in new window

UserAccounts2.xls
mcpp661Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

bignewfCommented:
Are you using exchange 2007? You can use power shell to create the mailboxes. I can find you the commands to do this
0
mcpp661Author Commented:
No, 2003. Plus I'd like to keep it in VBScript.
0
bignewfCommented:
Try t' -----------------------------------------------------------------
' Script: createusersfromcsv+exch+err.vbs
' Author: Scott Lowe
' Input: CSV file with layout logonname,firstname,lastname,password
' Date: January 2, 2006
' Change log:
' no changes
'------------------------------------------------------------------

Option Explicit                  ' Forces declaration of variables - always use this

Dim sIOLocation
Dim sCSVFile
Dim sLogFile
Dim oInputConnection
Dim oInputRecordSet
Dim oLogObject
Dim oLogOutput
Dim oNewUser

' Variables needed for LDAP connection
Dim oRootLDAP
Dim oContainer

' Holding variables
Dim sLogon
Dim sFirstName
Dim sLastName
Dim sDisplayName
Dim sPassword
Dim nPwdLastSet
Dim nUserAccountControl ' Used to enable the account
Dim sLDAPdomain
Dim sLDAPExchangeServer      ' See instructions before running script
Dim sLDAPmail                  ' Will be set to sLogon + "@" + sLDAPdomain
Dim sLDAPmailnickname      ' Will be set to sLogon
Dim sLDAPhomeMDB            ' See instructions before running script
Dim sLDAPmDBUseDefaults      ' Will be set to true

' Set the full path to the Exchange server
' Broken up into separate sections for readability
' If you have multiple Exchange servers, consider including the
'      Exchange server name in your CSV file
' See accompanying instructions for quickly determining this field
'      your organization
sLDAPExchangeServer = "/o=First Organization"
sLDAPExchangeServer = sLDAPExchangeServer & "/ou=First Administrative Group"
sLDAPExchangeServer = sLDAPExchangeServer & "/cn=Configuration/cn=Servers"
sLDAPExchangeServer = sLDAPExchangeServer & "/cn=W2K3-STD"

' Set the Exchange homeMDB variable
' Broken up into separate sections for readability
' If you have multiple Exchange stores, consider including the
'      store name in your CSV file
' See accompanying instructions for quickly determining this field
'      your organization
sLDAPhomeMDB = "CN=Mailbox Store (W2K3-STD),"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=First Storage Group,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=InformationStore,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=W2K3-STD,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=Servers,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=First Administrative Group,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=Administrative Groups,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=First Organization,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=Microsoft Exchange,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=Services,"
sLDAPhomeMDB = sLDAPhomeMDB & "CN=Configuration,"
sLDAPhomeMDB = sLDAPhomeMDB & "DC=example,DC=com"

' Modify this to match your company's AD domain
sLDAPdomain="example.com"

' Location of CSV file and to which log files will be written
sIOLocation = "C:\Scripts\" 'KEEP TRAILING SLASH!

' Full path to input file
sCSVFile = sIOLocation&"example.csv"
sLogFile = sIOLocation&"IO.log"

' This value is set to true
' Indicates that the user account will use default mail store rules
sLDAPmDBUseDefaults = TRUE

' Commands used to open the CSV file and select all of the records
set oInputConnection = createobject("adodb.connection")
set oInputRecordSet = createobject("adodb.recordset")
oInputConnection.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & _
    sIOLocation & ";Extended Properties=""text;HDR=NO;FMT=Delimited"""
oInputRecordSet.open "SELECT * FROM " & sCSVFile,oInputConnection

' Open the log file for writing
set oLogObject = CreateObject("Scripting.FileSystemObject")
set oLogOutput = oLogObject.CreateTextFile(sLogFile)
oLogOutput.WriteLine Now & ": Log started"

' Create a connection to the Active Directory Users container.

Set oRootLDAP = GetObject("LDAP://rootDSE")
Set oContainer = GetObject("LDAP://cn=Users," & _
    oRootLDAP.Get("defaultNamingContext"))

' Allows processing to continue even if an error occurs (i.e. dup user)
' We put this below the CSV  and AD information since processing can
' continue with a single bad record, but not if there is a problem with
' the CSV file or AD connection
on error resume next

do until oInputRecordSet.EOF ' Reads the values (cells) in the sInputFile file.

err.clear                               ' Reset the error counter

' --------- Start creating user account
' Read variable information from the CSV file
' and build everything needed to create the account
sLogon = oInputRecordSet.Fields.Item(0).value
sFirstName = oInputRecordSet.Fields.Item(1).value
sLastName = oInputRecordSet.Fields.Item(2).value
sDisplayName = sLastName&", "&sFirstName
sPassword = oInputRecordSet.Fields.Item(3).value

' Build the User account
Set oNewUser = oContainer.Create("User","cn="&sFirstName&" "&sLastName)

oNewUser.put "sAMAccountName",lcase(sLogon)
oNewUser.put "givenName",sFirstName
oNewUser.put "sn",sLastName
oNewUser.put "UserPrincipalName",lcase(SLogon)&"@"&sLDAPdomain
oNewUser.put "DisplayName",sDisplayName
oNewUser.put "name",lcase(sLogon)

' Write this information into Active Directory so we can
' modify the password and enable the user account
oNewUser.SetInfo

'If it was successful, continue processing
If err.number = 0 Then
  oLogOutput.WriteLine Now & ": " & sLogon & ": Successfully created user account"

  ' Change the users password and turn off requirement to change at next login
  oNewUser.SetPassword sPassword
  oNewUser.Put "pwdLastSet", 0
 
  ' Enable the user account
  oNewUser.Put "userAccountControl", 512
  oNewUser.SetInfo
 
  ' If the password set and account enable was successful, indicate. Otherwise, write diagnostics.
  If err.number = "0" Then
    oLogOutput.WriteLine Now & ": " & sLogon & ": Successfully created user password and enabled account"
  Else
    oLogOutput.WriteLine Now & ": " & sLogon & ": Password or account enable error : " & err.number & err.description
  End If

  ' Build and write the users Exchange attributes
  oNewUser.put "mDBUseDefaults", sLDAPmDBUseDefaults
  oNewUser.put "mail", lcase(SLogon)&"@"&sLDAPdomain
  oNewUser.put "msExchHomeServerName", sLDAPExchangeServer
  oNewUser.put "mailnickname", lcase(sLogon)
  oNewUser.put "homeMDB", sLDAPhomeMDB
  oNewUser.SetInfo
 
  ' If the Exchange attributes were successful, indicate.  Otherwise, write diagnostics.
  If err.number = "0" Then
    oLogOutput.WriteLine Now & ": " & sLogon & ": Successfully created user's Exchange attributes"
  Else
    oLogOutput.WriteLine Now & ": " & sLogon & ": Exchange attributes error : " & err.number & err.description
  End If

Else
  oLogOutput.WriteLine Now & ": " & sLogon & ": Error creating account: " & err.number & err.description
End If

' --------- End of user account creation
' Move ahead to the next record
oInputRecordSet.movenext
Loop

' Close the log file
oLogOutput.WriteLine Now & ": Input ended"
oLogOutput.Closehis script:  
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mcpp661Author Commented:
Sorry I haven't left any feedback, I haven't had a chance to work on this this week at all. Once I can work on it I'll let you know how it goes. Thanks.
0
bignewfCommented:
good luck, let me know
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.