[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Need help in creating a VBScript to create Exchange mailboxes

Posted on 2008-11-16
5
Medium Priority
?
1,171 Views
Last Modified: 2012-08-13
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
0
Comment
Question by:mcpp661
  • 3
  • 2
5 Comments
 
LVL 15

Expert Comment

by:bignewf
ID: 22971613
Are you using exchange 2007? You can use power shell to create the mailboxes. I can find you the commands to do this
0
 

Author Comment

by:mcpp661
ID: 22971707
No, 2003. Plus I'd like to keep it in VBScript.
0
 
LVL 15

Accepted Solution

by:
bignewf earned 2000 total points
ID: 22971793
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
 

Author Comment

by:mcpp661
ID: 23017860
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
 
LVL 15

Expert Comment

by:bignewf
ID: 23018211
good luck, let me know
0

Featured Post

Creating Active Directory Users from a Text File

If your organization has a need to mass-create AD user accounts, watch this video to see how its done without the need for scripting or other unnecessary complexities.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this post, I will showcase the steps for how to create groups in Office 365. Office 365 groups allow for ease of flexibility and collaboration between staff members.
There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
how to add IIS SMTP to handle application/Scanner relays into office 365.
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Suggested Courses

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question