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

Select allOpen in new window

UserAccounts2.xls