Adding a mailbox to an existing AD account (Ex2003) 1

[JPJeffery]

I'm developing a script to create user accounts including a mailbox for each account.

The script creates the account and the mailbox correctly (using cdoexm) but I need it to be more specific/flexible about where the mailbox get created. Specifically, we have an Exchange server in each of our three offices, London, Hong Kong and New York, so a Hong Kong user should have their mailbox on the Hong Kong Server.

In thread329-880779 tsuji posted some code (timestamp 16 Jul 04 8:04) that looks like it'll do the job but my question is this. Which part of this line are variables that are specific to each Exchange/AD organisation?

objMailbox.createMailbox "LDAP://CN=DB"& strdb & ","& strstgrp &",CN=InformationStore,CN=exchange server-"& strexsvr & ",CN=Servers,CN=my companydomain,CN=Administrative Groups,CN=my company,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=intra,DC=my company,DC=com"

Obviously, words such as [tt]strdb[/tt] & [tt]strstgrp[/tt] are variables but some of the others look like they could be assumptions (and thus could could vary from one domain to the next).

Could anyone show which parts are variables by highlighting them in red, please?

For comparison, here's my code, pretty much as taken from the Microsoft site (the FindAnyMDB function just seems to use the first storage group it finds, which is too presumptive for our needs).

Sub CreateMailbox
    Dim objIADS
    Dim strDefaultNC
    Set objIADS = GetObject("LDAP://RootDSE")
    strDefaultNC = objIADS.Get("defaultnamingcontext")

    Set objIADSUser = GetObject("LDAP://CN=" & strUserName & "," & strOU & "," & strDefaultNC)

    If objIADSUser Is Nothing then
    	MsgBox "The objIADSUser is Nothing."
    Else
    	MsgBox "The objIADSUser is created successfully."
    End If

    Set objMailbox = objIADSUser
    objMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC)
    objIADSUser.Put "mailnickname","mailnickname" & strPre2kLogon
    objIADSUser.SetInfo
End Sub
'-------------------------------------------------------------------------------
Function FindAnyMDB(strConfigurationNC)
	wscript.echo "FindAnyMDB(" & strConfigurationNC & ")"
    Dim objConnection
	Dim objCommand
	Dim objRecordSet
	Dim strQuery

	' Open the Connection.
	Set objConnection = CreateObject("ADODB.Connection")
	set objCommand = CreateObject("ADODB.Command")
	Set objRecordSet = CreateObject("ADODB.Recordset")

	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "ADs Provider"

	' Build the query to find the private MDB.
	strQuery = "<LDAP://" & strConfigurationNC & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

	objCommand.ActiveConnection = objConnection
	wscript.echo "strQuery = '" & strQuery & "'"
    objCommand.CommandText = strQuery
	Set objRecordSet = objCommand.Execute

	' If you have an MDB, return the first one.
	If Not objRecordSet.EOF Then
		objRecordSet.MoveFirst
		FindAnyMDB = CStr(objRecordSet.Fields("ADsPath").Value)
	Else
		FindAnyMDB = ""
	End If


	'Clean up.
	objRecordSet.Close
	objConnection.Close
	Set objRecordSet = Nothing
	Set objCommand = Nothing
	Set objConnection = Nothing
End Function

Anyway, enough about me, how are you?

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

JJ, use ADSIEdit to browse the configuration container and it shoudl become obvious to you which parts of tsuji's string will change and which are constant throughout all installations.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

Is nice...(once I got ADSI Edit to show me the right thing)

Thanks MDM

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

Happy to assist. Another tool you might like is ADExplorer.

http://blogs.technet.com/sysinterna...tool-adexplorer-v1-0-and-various-updates.aspx

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

That's even better as ADSIEdit doesn't seem to allow me to copy and paste the LDAP string but ADExplorer does. Is nicer...!



JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

ADSIEdit does let you do that too. From the top portion of it you can select the text and copy despite the fact that it is not in a special text box.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

Well, I've triple checked the string my script produces against the string I've copied from ADExplorer but despite the fact that it matches I'm getting an error:

[tt]\Scripts\CreateAccount_v1.23.vbs(813, 5) (null): A constraint violation occurred.[/tt]

Line 813 is the third line in this code snippet:[code[] wscript.echo "Create the mailbox with" &vbCrLf & strMailbox
objMailbox.Put "homeMDB",strMailbox ' The LDAP string to create the mailbox
objMailbox.SetInfo[/code]

I'm running the script under the context of my Domain Admins account so permissions really shouldn't be the problem. Any ideas?

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

Post your full code if you would like some additional troubleshooting done.



I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

OK, here it is in all its glory. Please note, this is prior to a tidy-up of unused variables/constants/subs/functions and so on. Also, I've done a Find/Replace of our server names and company/AD/Domain names which might make one or two items look a bit 'odd'.

The account is created by MakeTheUser. Then the mailbox by CreateMailbox (which is from where the code snippet above was taken)

' Users .vbs
' Sample VBScript to create a User in Users .
' Author Guy Thomas [URL unfurl="true"]http://Computerperformance.co.uk/[/URL]
' Version 1.3 - September 2005
' ------------------------------------------------------'
' NOTES
' =====
' Create profile and home folders
' Create mailbox
' Add logon script
'
' Changes for Our Company Name:
' v1.14 - Adding duplicate account tests (this needs revisiting)
' v1.15 - Adding code to copy group memberships from another account
' v1.16 - Add code to find full AD path to each group
' v1.17 - Add code to create default password
' v1.18 - Add code to enable the account
' v1.19 - Create and permission Home and Profile folders and shares
' v1.20 - Create a local mailbox
' v1.21 - Trying a different method to create the mailbox (CDOEXM)
' v1.22 - Code to create a non-presumptive LDAP string to create the mailbox
'         on a local server.
' v1.23 - Going back to a 'native' AD LDAP approach

Option Explicit

'STRINGS
Dim strVersion
    strVersion = "1.23"
Dim strTitle
    strTitle = "Our Company Name Create User script v" & strVersion
Dim strUser, Msg, strLastName, strFirstName, strUserName, strUserName_t, strAlias
Dim strPath
Dim strDescription
Dim strMailbox
Dim strStoreName
Dim strStorageGroup
Dim strServer
Dim strAdminGroup
Dim strDomain
Dim strOffice
Dim strPhoneNumber
Dim strPre2kLogon
Dim strPost2kLogon
Dim ShortMsg
Dim strSourceAccount
Dim strSMTP
Dim strGroups
Dim strGroup
Dim strDNSDomain
Dim strOUErrorMsg
Dim strDC
Dim strPassword
Dim strOU
Dim strFileServer
Dim strEmailServer
Dim strHomeDrives
Dim strProfiles
Dim vbTab
    vbTab = "    "
Dim strFolder
Dim strMailboxLDAP

'CONSTANTS
Const intAccValue = 512
Const strDomainName = "OurCompanyName.com"
Const strPrimaryDC = "dc01"
Const strSecondaryDC = "dc04"
     'Here we assume London DC01 is up and running, but we should introduce a safety net later on:
      strDC = strPrimaryDC
Const strExchangeOrg = "Our Organisation Name"
Const strExchangeAdminGroup = "Our Company Name"
Const strHomeMDB = "Mailbox Store"
Const conMailboxLDAPpart1 = "CN=First Storage Group,CN=InformationStore,CN="
Const conMailboxLDAPpart2 = ",CN=Servers,CN=Our Company Name,CN=Administrative Groups,CN=Our Company Name,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=OurCompanyName,DC=com,OurCompanyName"

'LONDON
Const strLONOU              = "CN=Users"
Const strUKFileServer       = "LONSRV01"
Const strUKHomeDrives       = "E$\Personal"
Const strUKProfiles         = "E$\roamprofiles"
Const strUKEmailServer      = "LONEXC01"
Const strUKStorageGroup     = "First Storage Group"
'Const strUKHomeMDB          = "
'HONG KONG
Const strHKOU               = "CN=Hong Kong Users"
Const strHKFileServer       = "HKSRV01"
Const strHKHomeDrives       = "D$\Personal"
Const strHKProfiles         = "D$\roamprofiles"
Const strHKEmailServer      = "HKEXC01"
Const strHKStorageGroup     = "First Storage Group"
'Const strHKHomeMDB          = "
'NEW YORK
Const strNYOU               = "CN=New York Users"
Const strNYFileServer       = "NYSRV02"
Const strNYHomeDrives       = "E$\Usersdir"
Const strNYProfiles         = "E$\profiles"
Const strNYEmailServer      = "NYEXC01"
Const strNYStorageGroup     = "First Storage Group"
'Const strNYHomeMDB          = "

'OBJECTS
Dim objRootLDAP, objContainer, objNewUser
Dim objDomain
'Set objDomain = GetObject("WinNT://" & strDomainName)
Dim objUser
Dim objGroup
Dim objWMIService
Set objWMIService = GetObject("winmgmts:\\" & strDC & "\root\CIMV2")
Dim objServer
Dim objHomeShare
Dim objProfileShare
Dim objIADSUser
Dim objMailbox

'VARIABLES
Dim answer
Dim i
    i = 0
Dim varUserString
Dim varVariable
Dim varDefault
Dim varResponse
Dim intCACLS_Error

'ARRAYS
Dim arrGroups

'OBJECTS
Dim objSourceUser
Dim objWSHNetwork
Dim objFSO
Dim objShell

'CREATE OBJECTS
Set objDomain = GetObject("LDAP://" & strDomainName)
Set objWSHNetwork = CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

varUserString = objWSHNetwork.UserName

'===============================================================================
'===============================================================================
'MAIN
wscript.echo " " & strTitle & vbCrLf

Main
EnableTheAccount
CreateShares
CreateMailbox
QuitOut

'-------------------------------------------------------------------------------
Sub Main
    Msg = "Welcome to " & strTitle & vbCrLf & vbCrLf &_
            "Do you want to base this new account on an existing account?" & vbCrLf & vbCrLf &_
            "Choose YES to enter an existing account name to copy the group memberships from," & vbCrLf &_
            "Choose NO to create a fresh, 'blank' account (you'll have to add in group memberships manually afterwards)," & vbCrLf &_
            "Choose CANCEL to quit without making any changes to AD."
    ShortMsg = strTitle & " - Welcome. Base the new account on an existing account?"

    varResponse = MsgBox(Msg,vbYesNoCancel,ShortMsg)
    Select Case varResponse
        Case vbYes
            Msg = "Enter the email address of the user you want to copy group memberships from:"
            ShortMsg = "Enter source email address to copy groups from:"
            strSourceAccount = InputBox(Msg,strTitle & " - " & ShortMsg,"doe_j@OurCompanyName.com")
        Case vbNo
            ' Carry on
        Case vbCancel
            QuitOut
            wscript.quit
    End Select
    varResponse = ""

    if strSourceAccount <> "" then
        'wscript.echo " strSourceAccount = '" & strSourceAccount & "'"
        FindAliasFromEmailAddress
    end if
    'Msg = "Enter the user's FIRST name:"
    'strFirstName = InputBox(Msg,strTitle & " - Enter user's first name:","Darryl")

    Msg = "Enter the user's FIRST name:"
    varVariable = "strFirstName"
    varDefault = "A_Darryl"
    strFirstName = GetValue(varVariable,Msg,varDefault)

    Msg = "Enter the user's LAST name:"
    varVariable = "strLastName"
    varDefault = "Strawberry2"
    strLastName = GetValue(varVariable,Msg,varDefault)

    Msg = "Enter the user's account description:"
    varVariable = ""
    varDefault = "Clean Up hitter"
    strDescription = GetValue(varVariable,Msg,varDefault)

    Msg = "Enter the user's office location (London, New York or Hong Kong):"
    varVariable = ""
    varDefault = "London"
    strOffice = GetValue(varVariable,Msg,varDefault)
    'wscript.echo " DEBUG: strOffice = '" & strOffice & "'"

    SelectLocales

    Msg = "Enter the user's extension number:"
    varVariable = ""
    varDefault = "1234"
    strPhoneNumber = GetValue(varVariable,Msg,varDefault)

    ' USE THIS CODE FOR THE PRE-WINDOWS2000 ACCOUNT NAME : strUserName = lcase(strLastName & "_" & left(strFirstName,1))
    strUserName = strFirstName & " " & strLastName
    strAlias = lcase(strLastName & left(strFirstName,1))
    strPre2kLogon = lcase(strLastName) & "_" & lcase(left(strFirstName,1))
    strPost2kLogon = lcase(strLastName) & "_" & lcase(left(strFirstName,1)) & "@OurCompanyName.com"
    strSMTP = lcase(strLastName) & lcase(left(strFirstName,1)) & "@OurCompanyName.com"

    Msg = " User's name is '" & strFirstName & " " & strLastName & "'" &_
          vbCrLf & " Their Common Name will be '" & strUserName & "'" &_
          vbCrLf & " Their SAM Account Name (and email address) will be '" & strAlias & "(@OurCompanyName.com)" & "'" &_
          vbCrLf & " Their Logon Name will be '" & strAlias & "(@OurCompanyName.com)" & "'" &_
          vbCrLf & " Their Pre-2000 Logon Name will be '" & strPre2kLogon & "'" &_
          vbCrLf & " Their Windows 2000 Logon name will be '" & strPost2kLogon & "'" &_
          vbCrLf & " Their Description will be '" & strDescription & "'" &_
          vbCrLf & " Their Office will be '" & strOffice & "' (so the account will be placed in the " & right(strOu,(len(strOU))-3) & " OU)" &_
          vbCrLf & " Their Phone Number will be '" & strPhoneNumber & "'" &_
          vbCrLf & " Their OU will be '" & right(strOU,(len(strOU)-3)) & "'" &_
          vbCrLf & " Their home Exchange server will be '" & strEmailServer & "'"

    wscript.echo Msg
    answer = MsgBox(Msg,vbOkOnly,strTitle & " - Check the details")

    ' Bind to Active Directory & Users OU
    Set objRootLDAP = GetObject("LDAP://rootDSE")
    strDNSDomain = objRootLDAP.Get("DefaultNamingContext")
    'wscript.echo " strDNSDomain = '" & strDNSDomain & "'"
'    Set objContainer = GetObject("LDAP://cn=Users," & _
'        objRootLDAP.Get("defaultNamingContext"))
    Set objContainer = GetObject("LDAP://" & strOU & "," & _
        objRootLDAP.Get("defaultNamingContext"))

    TestIfTheUserExists
    'wscript.echo " strUserName_t = '" & strUserName_t & "'"
    If strUserName_t = "" then
        'wscript.echo " Calling MakeTheUser"
        MakeTheUser
    Else
        wscript.echo " Calling UseAlternativeName"
        UseAlternativeName
    End If
End Sub
'-------------------------------------------------------------------------------
Function MakeTheShare(strShare,strPath)
    wscript.echo "  Adding share to folder"
    on error goto 0
    Dim objShare
    Set objShare = objServer.Create("Fileshare", strShare)
    if err.number <> 0 then
        wscript.echo "   Error creating share!"
        wscript.echo "   Error = " & err.number
        Err.Clear
    End If
    objShare.Path = strPath
    objShare.Description = strFirstName & " " & strLastName
    objShare.SetInfo
    if err.number <> 0 then
        wscript.echo "   Error creating share!"
        wscript.echo "   Error = " & err.number
        Err.Clear
    Else
        wscript.echo "   Share added"
    End If
End Function
'-------------------------------------------------------------------------------
Sub CreateShares
    Wscript.echo " Create home data folder..."
'    Dim strFileServer_t
'    strFileServer_t = strFileServer
'    strFileServer = "OurCompanyNamelonvcs01"
'    Wscript.echo "  Connect to local file server"
    Set objServer = GetObject("WinNT://" & strFileServer & "/lanmanserver")
'    Dim strHomeDrives_t
'    strHomeDrives_t = strHomeDrives
'    strHomeDrives = "c$\Personal"
'    Dim strProfiles_t
'    strProfiles_t = strProfiles
'    strProfiles = "c$\roamprofiles"
    Dim strHomeDrive, strHomeShare
        strHomeDrive = "\\" & lcase(strFileServer) & "\" & lcase(strHomeDrives) & "\" & lcase(strPre2kLogon)
        strHomeShare = lcase(strPre2kLogon)
        'wscript.echo " strHomeDrive = " & strHomeDrive
        'wscript.echo " strHomeShare = " & strHomeShare
    Dim strProfile, strProfileShare
        strProfile = "\\" & lcase(strFileServer) & "\" & lcase(strProfiles) & "\" & lcase(strPre2kLogon)
        strProfileShare = lcase(strPre2kLogon) & "$"
        'wscript.echo " strProfile = " & strProfile
        'wscript.echo " strProfileShare = " & strProfileShare

    if not objFSO.FolderExists(strHomeDrive) Then
        'create the folder and share
        on error resume next
        objFSO.CreateFolder(strHomeDrive)
        if err.number <> 0  then
            wscript.echo " Error creating home drive folder!"
            DisplayErrorInfo
        Else
            wscript.echo "  Created " & strHomeDrive & "."' Adding in NTFS permissions for OurCompanyName\" & strPre2kLogon
            PermissionTheFolder(strHomeDrive)
            If Not objFSO.FolderExists(strHomeShare) Then
                Dim strShare
                'wscript.echo "  Call MakeTheShare for the Home drive"
                strPath = lcase(strHomeDrives) & "\" & lcase(strPre2kLogon)
                strPath = Replace(strPath,"$",":") ' To replace "C$\roamprofiles\Strawberry_d" with "C:\roamprofiles\Strawberry_d"
                'wscript.echo "strHomeShare = '" & strHomeShare & "'"
                'wscript.echo "strPath = '" & strPath & "'"
                'wscript.echo "  Call MakeTheShare"
                answer = MakeTheShare(strHomeShare,strPath)
            Else
                wscript.echo "  Share " & strHomeShare & " already exists..."
            End If
        end if
    End If

    Msg = "Create roaming profile folder?"
    answer = MsgBox(Msg,vbYesNo,strTitle & " - " & Msg)
    Wscript.echo " " & Msg & "..." 'Create home data folder (and roaming profile?)"
    Select Case answer
        Case vbYes
            if not objFSO.FolderExists(strProfile) Then
                'Create Folder and share
                on error resume next
                objFSO.CreateFolder(strProfile)
                if err.number <> 0  then
                    wscript.echo " Error creating roaming profile folder!"
                    DisplayErrorInfo
                Else
                    wscript.echo "  Created " & strProfile & "."' Adding in NTFS permissions for OurCompanyName\" & strPre2kLogon
                    PermissionTheFolder(strProfile)
                    If Not objFSO.FolderExists(strProfileShare) Then
                        'wscript.echo "  Call MakeTheShare for the Profile"
                        strPath = lcase(strProfiles) & "\" & lcase(strPre2kLogon)
                        strPath = Replace(strPath,"$",":") ' To replace "C$\roamprofiles\Strawberry_d" with "C:\roamprofiles\Strawberry_d"
                        'wscript.echo "strProfileShare = '" & strProfileShare & "'"
                        'wscript.echo "strPath = '" & strPath & "'"
                        'wscript.echo "  Call MakeTheShare"
                        answer = MakeTheShare(strProfileShare,strPath)
                    Else
                        wscript.echo "  Share " & strProfileShare & " already exists..."
                    End If
                end if
            End If
        Case vbNo
            ' Don't bother
    End Select
    answer = ""
    'strFileServer = strFileServer_t
    'strHomeDrives = strHomeDrives_t
    'strProfiles = strProfiles_t
    on error goto 0
End Sub
'-------------------------------------------------------------------------------
Sub PermissionTheFolder(strFolder)
    wscript.echo "   Permissioning " & strFolder
    intCACLS_Error = objShell.Run("%COMSPEC% /c Echo Y| cacls " & strFolder & " /e /c /g OurCompanyName\" & strPre2kLogon  & ":C", 2, True)

    If intCACLS_Error < 0 Then
        Wscript.Echo "   Error assigning permissions for user " & strPre2kLogon & " to folder " & strFolder
    Else
        Wscript.Echo "   Permissions successfully assigned for user " & strPre2kLogon & " to folder " & strFolder
    End If
End Sub
'-------------------------------------------------------------------------------
Sub SelectLocales
'    wscript.echo " DEBUG: IN SelectLocales strOffice = '" & strOffice & "'"
    Dim strOffice_t
    strOffice_t = lcase(strOffice)
'    wscript.echo " DEBUG: IN SelectLocales strOffice_t = '" & strOffice_t & "'"

    Select Case strOffice_t
        Case "london"
            strOU = strLONOU
            strFileServer = strUKFileServer
            strEmailServer = strUKEmailServer
            strHomeDrives = strUKHomeDrives
            strProfiles = strUKProfiles
            strOffice = "London"
        Case "hong kong"
            strOU = strHKOU
            strFileServer = strHKFileServer
            strEmailServer = strHKEmailServer
            strHomeDrives = strHKHomeDrives
            strProfiles = strHKProfiles
            strOffice = "Hong Kong"
        Case "hk"
            strOU = strHKOU
            strFileServer = strHKFileServer
            strEmailServer = strHKEmailServer
            strHomeDrives = strHKHomeDrives
            strProfiles = strHKProfiles
            strOffice = "Hong Kong"
        Case "new york"
            strOU = strNYOU
            strFileServer = strNYFileServer
            strEmailServer = strNYEmailServer
            strHomeDrives = strNYHomeDrives
            strProfiles = strNYProfiles
            strOffice = "New York"
        Case "ny"
            strOU = strNYOU
            strFileServer = strNYFileServer
            strEmailServer = strNYEmailServer
            strHomeDrives = strNYHomeDrives
            strProfiles = strNYProfiles
            strOffice = "New York"
        Case Else
            Msg = """" & strOffice & """ is not a valid office name!" & vbCrLf & vbCrLf &_
                  "Please re-enter the office name using one of the following choices (without the quote marks!):" & vbCrLf & vbCrLf &_
                  "  ""London""" & vbCrLf &_
                  "  ""Hong Kong""" & vbCrLf &_
                  "  ""New York""" & vbCrLf
            varVariable = ""
            varDefault = "Shea Stadium"
            strOffice = GetValue(varVariable,Msg,varDefault)
            SelectLocales
    End Select
    ' Build LDAP string
    strMailbox = strMailbox & "CN=Mailbox Store (" & strEMailServer & ")"
    strMailbox = strMailbox & ",CN=First Storage Group"
    strMailbox = strMailbox & ",CN=InformationStore"
    strMailbox = strMailbox & ",CN=" & strEMailServer
    strMailbox = strMailbox & ",CN=Servers"
    strMailbox = strMailbox & ",CN=Our Company Name"
    strMailbox = strMailbox & ",CN=Administrative Groups"
    strMailbox = strMailbox & ",CN=Our Company Name"
    strMailbox = strMailbox & ",CN=Microsoft Exchange"
    strMailbox = strMailbox & ",CN=Services"
    strMailbox = strMailbox & ",CN=Configuration"
    strMailbox = strMailbox & ",DC=OurCompanyName,DC=com,OurCompanyName" ' [dc01.OurCompanyName.com]"
    'strMailboxLDAP = "CN=Mailbox Store (" & strEmailServer & ")," & conMailboxLDAPpart1 & strEmailServer & conMailboxLDAPpart2
    'wscript.echo " The LDAP string to create the Mailbox is:" & vbCrLf & "  '" & strMailbox & "'"
    'QuitOut
End Sub
'-------------------------------------------------------------------------------
Function GetValue(varVariable,Msg,varDefault)
    varVariable = InputBox(Msg,strTitle & " - " & Msg,varDefault)
    if varVariable = "" then
        Dim NoValueMsg
        NoValueMsg = " No value given. Try again?"
        varResponse = MsgBox(NoValueMsg,vbYesNo,NoValueMsg)
        Select Case varResponse
            Case vbYes
                strFirstName = GetValue(varVariable,Msg,varDefault)
            Case vbNo
                QuitOut
                wscript.quit
        End Select
    end if
    Getvalue = varVariable
End Function
'-------------------------------------------------------------------------------
Sub QuitOut
    Set objRootLDAP = Nothing
    Set objContainer = Nothing
    Set objNewUser = Nothing
    Set objDomain = Nothing
    Set objWSHNetwork = Nothing
    Set objSourceUser = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
    wscript.quit
End Sub
'-------------------------------------------------------------------------------
Sub EnableTheAccount
    wscript.echo " Enabling the account"
    on error resume next
    objNewUser.Put "userAccountControl", intAccValue    ' 512 enables the account, 514 disables the account
    objNewUser.SetInfo
    if Err.Number <> 0 then
        DisplayErrorInfo
    Else
        Wscript.echo "  Done"
    End if
End Sub
'-------------------------------------------------------------------------------
Sub MakeTheUser
'    wscript.echo " Binding to Active Directory to make the user account"
    ' Bind to Active Directory, Users container.
'    Set objRootLDAP = GetObject("LDAP://rootDSE")
'    Set objContainer = GetObject("LDAP://cn=Users," & _
'    Set objContainer = GetObject("LDAP://cn=" & strOU & "," & _
    Set objContainer = GetObject("LDAP://" & strOU & "," & _
    objRootLDAP.Get("defaultNamingContext"))

    ' Build the actual User.
    wscript.echo UCASE(" Building account '") & UCASE(strUserName) & "'"' & " for " & strFirstName & " " & strLastName
    Set objNewUser = objContainer.Create("User", "cn=" & strUserName)
    objNewUser.Put "GivenName",                  "GivenName" & strFirstName   ' First Name
    objNewUser.Put "SN",                         "SN" & strLastName    ' Last Name
    objNewUser.Put "DisplayName",                "DisplayName" & strUserName    ' Display Name
    objNewUser.Put "Description",                strDescription ' Description
    objNewUser.Put "PhysicalDeliveryOfficeName", strOffice      ' Office
    objNewUser.Put "TelephoneNumber",            strPhoneNumber ' Telephone Number
    'objNewUser.Put "SAMAccountName",             strAlias      ' Pre Windows 2000 logon name
    objNewUser.Put "SAMAccountName",             "SAM" & strPre2kLogon  ' Pre Windows 2000 logon name
    objNewUser.Put "UserPrincipalName",          "UPN" & strPost2kLogon ' POST Windows 2000 logon name
    'objNewUser.Put "msExchHomeServerName",       strEmailServer ' Local Exchange Server
    'objNewUser.Put "homeMDB",                    strMailbox     ' The LDAP string to create the mailbox
    'objNewUser.Put "mail",                       "mail" & strSMTP
    'objNewUser.Put "mailnickname",               strPre2kLogon
    'objNewUser.Put "mDBUseDefaults",             "True"
    
    on error resume next
    objNewUser.SetInfo
    if Err.Number <> 0 then
        wscript.echo " ** Error creating account! **"
        DisplayErrorInfo
        wscript.echo " ** QUITTING! **"
        QuitOut
        wscript.quit
    End if
    
    on error goto 0
    if not strGroups = "" then
        AddGroups
    end if
    strPassword = "Password01"
    CreatePassword
End Sub
'-------------------------------------------------------------------------------
Sub CreatePassword
    If strPassword = "" then
        Dim strPassword_a, strPassword_b

        Dim objPassword
        Set objPassword = CreateObject("ScriptPW.Password")

        WScript.StdOut.Write "  Enter a password for the new account:"
        strPassword_a = objPassword.GetPassword()
        Wscript.Echo

        WScript.StdOut.Write "  Re-Enter the password to make sure:"
        strPassword_b = objPassword.GetPassword()
        Wscript.Echo

        if strPassword_a <> strPassword_b then
            wscript.echo "  ** Password don't match! Please try again! **"
            strPassword_a = ""
            strPassword_b = ""
            CreatePassword
        Else
            strPassword = strPassword_a
        End If
    End If
    
    Msg = " The password will be:" & vbCrLf & vbCrLf &_
        vbTab & strPassword & vbCrLf & vbCrLf &_
        " Is this OK?"

    answer = ""
    answer = MsgBox(Msg,vbYesNo,strTitle)

    Select Case answer
        Case vbYes
            'AGNB?
            on error resume next
            wscript.echo "   Adding the password to the account (this might take a few seconds, be patient)"
            objNewUser.SetPassword strPassword
            if Err.Number <> 0 Then
                DisplayErrorInfo
                wscript.echo "   It's likely that password doesn't match the domain's password complexity requirements."
                wscript.echo "   Please try again!"
                CreatePassword
            Else
                wscript.echo "    Done"
            End If
            on error goto 0
        Case vbNo
            strPassword = ""
            CreatePassword
    End Select
    'End If
End Sub
'-------------------------------------------------------------------------------
Sub FindAliasFromEmailAddress
    wscript.echo " Find user account name for email address " & strSourceAccount 'strUserName
	Dim strSourceAccount_t
'    Set objContainer = GetObject("LDAP://cn=Users," & _
' This following line needs changing as we'll have to search the whole of AD to check
    Set objContainer = GetObject("LDAP://" & strOU & "," & _
    objRootLDAP.Get("defaultNamingContext"))
    For Each objSourceUser In objContainer
        'wscript.echo "FindAliasFromEmailAddress FOR loop"
        'wscript.echo "'" & LCase(objUser.Name) & "' = '" & LCase(strUserName) & "'"
		strSourceAccount_t = objSourceUser.userPrincipalName
        'wscript.echo " IS '" & strSourceAccount_t & "' = '" & strSourceAccount & "'?"
        If LCase(strSourceAccount_t) = LCase(strSourceAccount) Then
            strSourceAccount = objSourceUser.Name
            strSourceAccount = right(strSourceAccount,len(strSourceAccount)-3)
            'wscript.echo " Found account '" & strSourceAccount & "' who is a member of the following groups:" 'objUser.Name & "'"
            wscript.echo " Recording the group names to add the new account to"
            GetGroups
            Exit Sub
		End If
	Next
	Msg = "No account found for email address '" & LCase(strSourceAccount) & "'!" & vbCrLf & vbCrLf &_
        "Perhaps you mistyped the email address." & vbCrLf & vbCrLf &_
        "Select YES to try again," & vbCrLf &_
        "Select NO to create a fresh account (add in the groups manually later)," & vbCrLf &_
        "Select CANCEL to quit without making any changes to AD."

        varResponse = MsgBox(Msg,vbYesNoCancel,"Bad email address!")
        Select Case varResponse
            Case vbYes
                Msg = "Enter the email address of the user you want to copy group memberships from:"
                ShortMsg = "Enter source email address to copy groups from:"
                strSourceAccount = InputBox(Msg,strTitle & " - " & ShortMsg,"doe_j@OurCompanyName.com")
                FindAliasFromEmailAddress
            Case vbNo
                QuitOut
                wscript.quit
        End Select
    'end if
    'Getvalue = varVariable
End Sub
'-------------------------------------------------------------------------------
Sub GetGroups
    'Set objUser = GetObject("LDAP://CN=John Doe,CN=Users,DC=OurCompanyName,DC=com")
    Dim colGroups, objGroup
    Set colGroups = objSourceUser.Groups
    For Each objGroup in colGroups
        'Wscript.Echo " " & objGroup.CN
        strGroup = GetGroupADPath(objGroup.CN)
'        strGroups = strGroups & objGroup.CN & vbCrLf
        strGroups = strGroups & strGroup & vbCrLf
    Next
    arrGroups = split(strGroups,vbCrLf)
    '{DEBUG}
    'For Each strGroup in arrGroups
    '    if not strGroup = "" then
    '        wscript.echo " - " & strGroup
    '    End If
    'Next
    '{/DEBUG}
End Sub
'-------------------------------------------------------------------------------
Sub AddGroups
    Wscript.echo " Adding " & strUserName & " to groups"
    For Each strGroup in arrGroups
        if not strGroup = "" then
            'wscript.echo " Adding " & strUserName & " to group '" & strGroup & "'..."
'            Set objGroup = GetObject("LDAP://"& strGroup _
'                & strOU & strDNSDomain)
            'wscript.echo " Set objGroup = GetObject(""LDAP://" & strDc & "/CN=" & strGroup & "," & strDNSDomain & """)"
            '               Set objGroup = GetObject("LDAP://" & strDc & "/CN=" & strGroup & "," & strDNSDomain)
            'wscript.echo " Set objGroup = GetObject(" & strGroup & ")"
                           Set objGroup = GetObject(strGroup)
            objGroup.add(objNewUser.ADsPath)
        End If
    Next
End Sub
'-------------------------------------------------------------------------------
Function GetGroupADPath(strGroup)
    Set objRootLDAP = GetObject("LDAP://rootDSE")
    strDNSDomain = objRootLDAP.Get("defaultNamingContext")

    Set objConnection = CreateObject("ADODB.Connection")
    Dim objConnection
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"

    'strGroup = "DEPT_IT"
    Dim oRs
    Set oRs = objConnection.Execute("SELECT adspath " & _
              "FROM 'LDAP://" & strDNSDomain & "'" & _
              "WHERE objectCategory='group' AND " & _
              "Name='" & strGroup & "'")
    Dim sAdsPath
    If Not oRs.EOF Then
        sAdsPath = oRs("adspath")
        'msgbox(sAdspath)
        GetGroupADPath = sAdsPath
    Else
        msgbox(strGroup & " not in AD")
    End If
End Function
'-------------------------------------------------------------------------------
Sub TestIfTheUserExists
    wscript.echo " Test uniqueness of " & strAlias 'strUserName
    'wscript.echo " LCase(strUserName) = '" & LCase(strUserName) & "'"
	For Each objUser In objDomain
        'wscript.echo "'" & LCase(objUser.Name) & "' = '" & LCase(strUserName) & "'"
		If LCase(objUser.Name) = LCase(strUserName) Then
            wscript.echo " Duplicate name found!"
            SuggestAlternativeName
            Exit Sub
		End If
        'Else
            'MakeTheUser
        'End if
	Next
End Sub
'-------------------------------------------------------------------------------
Sub SuggestAlternativeName
    WSCRIPT.ECHO " Starting creation of alternative name"
    i = i + 1
    wscript.echo " i = '" & i & "'"
    if i = 1 then
        strUsername_t = strUserName
    else
        strUserName = strUserName_t
    end if
    strUserName = strUserName & cstr(i)
    TestIfTheUserExists
End Sub
'-------------------------------------------------------------------------------
Sub UseAlternativeName
    Msg = "There is already an account named " & strUsername_t & vbCrLf & vbCrLf &_
          "I suggest using " & strUserName & " instead." & vbCrLf & vbCrLf &_
          "Is this OK?" & vbCrLf & vbCrLf &_
          "Select YES to try username " & strUserName & vbCrLf &_
          "Select NO to enter your own alternative username" & vbCrLf &_
          "Select CANCEL to quit the script without committing any changes to AD"

    varResponse = MsgBox(Msg,vbYesNoCancel,strTitle & " - Duplicate user account!")

    Select Case varResponse
        Case vbYes
            Msg = "You selected Yes, so creating the account called " & strUserName
            answer = MsgBox(Msg,vbOkOnly,strTitle)
            MakeTheUser
        Case vbNo
            Msg = "You selected no, please enter the username you'd like me to try:"
            i=0
            strUserName = InputBox(Msg,strTitle)
            TestIfTheUserExists
            'QuitOut
            'WScript.Quit
        Case vbCancel
            Msg = "You selected Cancel, so quitting the script. No changes to AD will be committed by this script"
            answer=MsgBox(Msg,vbOkOnly,strTitle)
            QuitOut
    End Select
End Sub
'-------------------------------------------------------------------------------
Sub DisplayErrorInfo
        'Wscript.echo " Error: " & Err.Number
        Wscript.echo " Error (Hex): &H" & Hex(Err.Number)
        if Err.Source <> "" then
            Wscript.echo " Source: " & Err.Source
        End If
        If Err.Description <> "" then
            Wscript.echo " Description: " & Err.Description
        End If
        Err.Clear
End Sub
'-------------------------------------------------------------------------------
Sub CreateMailbox
    Dim objIADS
    Dim strDefaultNC
    Set objIADS = GetObject("LDAP://RootDSE")
    strDefaultNC = objIADS.Get("defaultnamingcontext")

    Set objIADSUser = GetObject("LDAP://CN=" & strUserName & "," & strOU & "," & strDefaultNC)

    If objIADSUser Is Nothing then
    	MsgBox "The objIADSUser is Nothing."
    Else
    	MsgBox "The objIADSUser is created successfully."
    End If

    Set objMailbox = objIADSUser
    objMailbox.Put "msExchHomeServerName",strEmailServer ' Local Exchange Server
    objMailbox.SetInfo
    wscript.echo "Create the mailbox with" &vbCrLf & strMailbox
    objMailbox.Put "homeMDB",strMailbox     ' The LDAP string to create the mailbox
    objMailbox.SetInfo
    objMailbox.Put "mail","mail" & strSMTP
    objMailbox.SetInfo
    objMailbox.Put "mailnickname",strPre2kLogon
    objMailbox.SetInfo
    objMailbox.Put "mDBUseDefaults","True"
    objMailbox.SetInfo
End Sub
'-------------------------------------------------------------------------------
Sub CreateMailbox_CDO
    ' This version of the CreateMailbox subroutine was using CDO for Exchange Management
    ' but didn't work as it produced the following error:
    ' CreateAccount_v1.22.vbs(797, 5) (null): Invalid Argument.
    '
    ' ID no: c103071f
    ' Microsoft CDO for Exchange Management
    Dim objIADS
    Dim strDefaultNC
    Set objIADS = GetObject("LDAP://RootDSE")
    strDefaultNC = objIADS.Get("defaultnamingcontext")

    Set objIADSUser = GetObject("LDAP://CN=" & strUserName & "," & strOU & "," & strDefaultNC)

    If objIADSUser Is Nothing then
    	MsgBox "The objIADSUser is Nothing."
    Else
    	MsgBox "The objIADSUser is created successfully."
    End If

    Set objMailbox = objIADSUser
    objMailbox.CreateMailbox "LDAP://" & strMailboxLDAP  'FindAnyMDB("CN=Configuration," & strDefaultNC)
    objIADSUser.Put "mailnickname","mailnickname" & strPre2kLogon
    objIADSUser.SetInfo
End Sub
'-------------------------------------------------------------------------------
Function FindAnyMDB(strConfigurationNC)
    ' Not used in this version of the script
	wscript.echo "FindAnyMDB(" & strConfigurationNC & ")"
    Dim objConnection
	Dim objCommand
	Dim objRecordSet
	Dim strQuery

	' Open the Connection.
	Set objConnection = CreateObject("ADODB.Connection")
	set objCommand = CreateObject("ADODB.Command")
	Set objRecordSet = CreateObject("ADODB.Recordset")

	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "ADs Provider"

	' Build the query to find the private MDB.
	strQuery = "<LDAP://" & strConfigurationNC & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

	objCommand.ActiveConnection = objConnection
	wscript.echo "strQuery = '" & strQuery & "'"
    objCommand.CommandText = strQuery
	Set objRecordSet = objCommand.Execute

	' If you have an MDB, return the first one.
	If Not objRecordSet.EOF Then
		objRecordSet.MoveFirst
		FindAnyMDB = CStr(objRecordSet.Fields("ADsPath").Value)
	Else
		FindAnyMDB = ""
	End If


	'Clean up.
	objRecordSet.Close
	objConnection.Close
	Set objRecordSet = Nothing
	Set objCommand = Nothing
	Set objConnection = Nothing
End Function

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

Can you verify the output you are seeing for strMailbox?

Also, I notice in your CDO section you set a value to strMailboxLDAP but the line that sets that variable is commented out.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

Yes, in Sub CreateMailbox this line verifies the LDAP string:

wscript.echo "Create the mailbox with" &vbCrLf & strMailbox

(and it is correct when compared the the string copied and pasted from ADExplorer).

The Sub CreateMailbox_CDO is not currently in use as it also produces an error (as per the comments at the top of that sub) and so I tried going back to the 'native' LDAP string as I felt I had a better understanding of how to build the LDAP string correctly. Hence the line that assigns the strMailboxLDAP variable isn't used so I commented it out.

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

I was looking for you to post the actual value returned in the pop up.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

D'Oh...
[tt]CN=Mailbox Store (LONEXC01),CN=First Storage Group,CN=InformationStore,CN=LONEXC01,CN=Servers,CN=Our Company Name,CN=Administrative Groups,CN=Our Company Name,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=OurCompanyName,DC=com,OurCompanyName[/tt]



JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

The end part of that looks malformed: DC=OurCompanyName,DC=com,OurCompanyName

Should just be
DC=OurCompanyName,DC=com

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

I thought that, but

A) That's what ADExplorer and ADSIEdit show me to be the LDAP string and
B) I've tried it without and I still get the same error.

e.g. [tt]CN=Mailbox Store (LONEXC01),CN=First Storage Group,CN=InformationStore,CN=LONEXC01,CN=Servers,CN=Our Company Name,CN=Administrative Groups,CN=Our Company Name,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=OurCompanyName,DC=com[/tt]

It's a mystery to me where it gets the ",OurCompanyName" from.

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

This may help you:

http://support.microsoft.com/default.aspx/kb/327079

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

Yes, tried that code (it's the last two subs/functions in the code I posted although I notice the FindAnyMDB function is missing some of the lines from the copy and paste) and it does work BUT I need to be able to specify which server a mailbox should be created on. i.e. a new user in the Hong Kong office should have their mailbox on the Hong Kong server.

I suppose I could look in to coding a move of the mailbox after it gets created in London but that just seems daft...

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

While doing some reading on this I found mention of having problems if you don't specify the domain controller to connect to in your LDAP connection. Try connecting to a DC in Hong Kong.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[JPJeffery]

Well, it's working now.

A combination of two things did the trick. First there was adding in the name of a local DC to the LDAP string then there was the removal of the apparently errant company name after the company that was being added to the end of the LDAP string (my 'proof' for doing this was to compare the output from [tt]objRootLDAP.Get("defaultNamingContext")[/tt]

Thanks for all your help, Markdmac.

JJ
[small][purple]Variables won't. Constants aren't[/purple]
There is no apostrophe in the plural of PC (or PST, or CPU, or HDD, or FDD, and so on)[/small]

 

[markdmac]

Glad you finally got it working. Happy to have been of assistance.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.