Hi,

I'm working in a rather big society in Italy, and some days ago my
boss ask me for a script that add a user, insert into a group, create
his mailbox, add an SMTP address and let the user use the mailbox
immediately.

After two days of work, searching the internet and on some books, I
completed it, the script it's fully working now, it's very FAR from
being perfect, but
it also log everything in a file "output.txt".


If you want to use this script "as is" you have only to change the
initial variabiles and create data file INPUT.XLS as:

name,surname,password,group,accountName,smtpAddress in each column.
you can omit smtpAddress .

To use it you need a Windows XP/2000/2003 workstation in the
destination domain, Excel installed and you have to log as domain
Admin

I hope it can be useful to somebody, sorry for the comments and the
log in italian.

Davidhoff


====================START: CreateUser-Mailbox.vbs=================

'Definizione Variabili

Const NomeFile = "INPUT.XLS" 'Nome del file Exel di
input
Const strOutputFile="output.txt" 'Nome del file di
output/Log

DomainNameDc = "DC=domain,DC=com"
ServerDC = "DomainControllerName" 'Nome del domain controller
strDomain="domain.com" 'Dominio dove creare gli
account


'Dati di Exchange per la creazione della MailBox

strSmtpDomain = "@domain.it" 'Dominio SMTP per la
creazione dell'SMTP Address 'nome.cognome@...'
strMailboxStore = "Mailbox Store (ExchangeMachineName)" 'Nome del
Mailbox store dove creare la mailbox
strStorageGroup = "First Storage Group" 'Nome dello Storage Group
strExchangeServer = "ExchangeMachineName" 'Nome del server
di Exchange
strAdministrativeGroup = "First Administrative Group" 'Nome
dell'Administrative Group
strExchangeOrg = "ExchangeORG" 'Nome dell'organizzazione
Exchange


Public UtenteNonCreato
Public Errati
Public DominioClient
Public DomainController
Public ServerDC
Public DomainNameDc
Public strAccountDomain




strAccountDomain = "@" & strDomain




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' ----------------- main() ------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const OPEN_FILE_FOR_APPENDING = 8
DIM Totale

Errati=0
Totale=0
Mailbox=0

LogMessage " "
Logmessage ">==== Inizio esecuzione dello script: " & Now()


'Seleziona il tipo di comando da inviare
Wscript.Echo( "Script per la creazione di utenti all'interno del
dominio '" & strDomain & "'" & vbCrLf _
& "File di input: " & NomeFile & vbCRLF & vbCrLf &
"Digita 'ok' per continuare" & vbCrLf )

WScript.StdOut.Write(">")
WScript.StdIn.Read(0)
strOk = WScript.StdIn.ReadLine()

If (UCase(strOK) <> "OK") Then
Logmessage ">==== Esecuzione annullata: " & Now()
WScript.Quit
End If



LogMessage "Esecuzione su Domain Controller: " & ServerDC

set ofs=wscript.createobject("scripting.FileSystemObject")

strInputFile = ofs.GetAbsolutePathName(NomeFile)
LogMessage "Utilizzo file di input: " & strInputFile
LogMessage " "

on error resume Next

FindDomain

'Open input file
'Start EXCEL and display it to the user
Set oXL = WScript.CreateObject("EXCEL.application")
'oXL.Visible = True

'Open the workbook passed in the command line
oXL.workbooks.open strInputFile

'Activate the Add page
oXL.sheets("Add").Activate

'Put the cursor in the starting cell

oXL.ActiveSheet.range("A1").Activate

'Step to the next row
'oXL.activecell.offset(1, 0).Activate

'Until we run out of rows


Do While oXL.activecell.Value <> ""

'Lettura delle celle nella riga di input

strName = TRIM(oXL.activecell.offset(0, 0).Value)
strSurname = TRIM(oXL.activecell.offset(0, 1).Value)
strPassword = TRIM(oXL.activecell.offset(0, 2).Value)
strGroup = TRIM(oXL.activecell.offset(0, 3).Value)
strAccount = Trim(oXL.activecell.offset(0, 4).Value)
strSmtpAddress1 = Trim(oXL.activecell.offset(0, 5).Value)
Totale= Totale + 1

Wscript.Echo (vbCrLf & "Creazione Utente '" & strName & " " &
strSurname & "'")
LogMessage " "
LogMessage "Creazione Utente " & strName & " " & strSurname
CreateUser strName, strSurname, strAccount, strPassword, strGroup,
strSmtpAddress1


'Step to the next user...

oXL.activecell.offset(1, 0).Activate

Loop
LogMessage " "
LogMessage "Utenti totali: " & totale
LogMessage "Utenti inseriti correttamente: " & totale - Errati
LogMessage "MailBox create: " & Mailbox


'Done. close excel spreadsheet

Wscript.Echo(vbCrLf & "Fine esecuzione." & vbCrLf & vbCrLf & "Utenti
errati: " & Errati & vbCrLf _
& "Utenti inseriti: " & Totale - Errati &
vbCrLf _
& "MailBox create: " & Mailbox)

Logmessage "<==== Termine esecuzione dello script: " & Now()

oXL.application.quit

Set objFileSystem = Nothing






'Definizione Funzioni

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Sub FindDomain ()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub FindDomain ()

Set rootDSE = GetObject("LDAP://RootDSE")
DominioClient = rootDSE.Get("defaultNamingContext")
ParzDomainController = Replace(DominioClient,"DC=",".")
DomainController = ServerDC & Replace(ParzDomainController ,",","")

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Sub CreateUser ()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub CreateUser (strName,strsurname,strAccount,strPassword,strGroup,strSmtpAddress1)

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
DomainName = "DC=" & ServerDC & DomainNameDC
DisplayName = strName & " " & strSurname
UtenteNonCreato=0

on error resume Next

account = strAccount

IF Searchuser (account) = 0 Then

Set objOU = GetObject("LDAP://cn=users,"& DomainNameDC)
If Err.Number <> 0 Then
Wscript.Echo("*** '"& DisplayName &"'" & " - Utente non creato.
Riferimenti errati. Errore=" & CStr(Err.Number) & _
" " & CStr(Err.Description))
LogMessage "*** " & DisplayName & " - Utente non creato.
Riferimenti errati. Errore=" & CStr(Err.Number) & _
" " & CStr(Err.Description)
UtenteNonCreato=1
Err.Clear
Errati=Errati+1
Exit Sub
End If

'Cerca il gruppo a cui aggiungere l'utente. Se non esiste non crea
l'utente
Set objGroup = GetObject("LDAP://cn=" & strGroup & ",cn=users," &
DomainNameDC)
If Err.Number <> 0 Then
Wscript.Echo("*** '"& DisplayName &"'" & " - Utente non creato.
Gruppo non esistente: '" & strGroup & "'" & vbCrLf _
& "Errore= " & CStr(Err.Number) & " " &
CStr(Err.Description))
LogMessage "*** " & DisplayName & " - Utente non creato. Gruppo
non esistente: " & strGroup & vbCrLf _
& "Errore= " & CStr(Err.Number) & " " &
CStr(Err.Description)
UtenteNonCreato=1
Err.Clear
Errati=Errati+1
Exit Sub
End If


Set objUser = objOU.Create("User", "cn=" & strName & " " & strsurname)
objUser.Put "sAMAccountName", account
objUser.Put "givenname", strName
objUser.Put "sn", strSurname
objUser.Put "displayName", DisplayName
objUser.Put "userPrincipalName", account & strAccountDomain
objUser.SetInfo
objUser.SetPassword strPassword
objUser.AccountDisabled = False
objUser.SetInfo

'Imposta 'password never expire'
objUser.userAccountControl = objUser.userAccountControl Or
ADS_UF_DONT_EXPIRE_PASSWD
objUser.SetInfo


'Aggiunge l'utente al gruppo
objGroup.Add(objUser.AdsPath)
objGroup.SetInfo
Set objGroup = Nothing

Wscript.Echo("Creato utente: '" & DisplayName & "' - Group= '" &
strGroup & "'")
LogMessage "Creato utente: '" & DisplayName & "' - Group= '" &
strGroup & "'"

' Crea la MailBox

strUrL = "LDAP://CN="& strMailboxStore &",CN=" & strStorageGroup &
",CN=InformationStore," & _
"CN=" & strExchangeServer & ",CN=Servers,CN=" &
strAdministrativeGroup & ",CN=Administrative Groups," & _
"CN=" & strExchangeOrg & ",CN=Microsoft
Exchange,CN=Services,CN=Configuration," & DomainNameDc

TimeInterval = 10000
NumofTry = 9
iCounter = 0

' A seconda della grandezza della rete, l'aggiornamento del Directory
potrebbe impiegare alcuni secondi
' Proviamo a creare la mailbox con tentativi ogni 10 secondi per 1,5
minuti

Do While iCounter < NumofTry

' Crea la mailbox all'interno del MailBox Store
bContinue = CreateNewUserMailbox(objUser, strUrL,
DisplayName)

' Continua se CreateNewUserMailbox ha successo
If bContinue Then Exit Do
iCounter = iCounter + 1
' attende prima di riprovare
wscript.sleep(TimeInterval)
Loop

' Se non riesce a creare la mailbox da errore
If iCounter >= NumofTry Then
wscript.echo "*** Errore nella creazione della mailbox: "
& DisplayName & "."
LogMessage "*** " & DisplayName & " - MailBox non creata.
" & vbCrLf _
& "Errore= " & CStr(Err.Number) & " " &
CStr(Err.Description)
bContinue = False
Exit Sub
End If

If strSmtpAddress1 <> "" Then

'crea l'alias nome.cognome@domain
strSmtpAddress2 = Lcase(Replace(strName," ","") & "." &
Replace(strsurname," ","") & strSmtpDomain)

AddSmtpAddress objUser,strSmtpAddress1,strSmtpAddress2

Set objUser = Nothing

End If
Else
WScript.Echo("*** '" & DisplayName & "'" & " - Utente non creato.
Account '" & account & "' già esistente.")
LogMessage "*** " & DisplayName & " - Utente non creato. Account " &
account & " già esistente."
Errati=Errati+1
UtenteNonCreato=1
end IF

End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Sub CreateNewUserMailbox ()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function CreateNewUserMailbox(objUser, strLDAPUrl,strName)
On Error Resume Next

CreateNewUserMailbox = False

' Variables
Dim objMailbox 'As CDOEXM.IMailboxStore

' Get the IMailboxStore interface.
Set objMailbox = objUser

' Create a mailbox for the recipient on the specified Exchange
server.
objMailbox.CreateMailbox strLDAPUrl

'Enable immediate-logon for the user.
objUser.Put "msExchUserAccountControl", 2

' Save changes to the user object.
objUser.SetInfo

' Error handling.
If Err.Number <> 0 Then
WScript.Echo("*** '"& strName &"'" & " - MailBox non creata. "
& vbCrLf _
& "Errore= " & CStr(Err.Number) & " " &
CStr(Err.Description))

LogMessage "*** " & strName & " - MailBox non creata. " &
vbCrLf _
& "Errore= " & CStr(Err.Number) & " " &
CStr(Err.Description)

' Clean up.
Set objUser = Nothing
Set objMailbox = Nothing

CreateNewUserMailbox = False

Exit Function
End If

' Clean up.
Set objMailbox = Nothing

WScript.Echo("'" + strName + "' Mailbox creata.")
LogMessage strName & " - MailBox creata. " & vbCrLf

Mailbox = mailbox + 1
CreateNewUserMailbox = True

End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Sub AddSmtpAddress ()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function AddSmtpAddress(objUser,strSmtpAddress1,strSmtpAddress2)

Const ADS_PROPERTY_APPEND = 3
'// This adds a non-primary address. for primary use "SMTP:"

objUser.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", array ("smtp:" &
strSmtpAddress1)
objUser.SetInfo
LogMessage "Aggiunto SMTP Address: " & strSmtpAddress1
WScript.Echo("Aggiunto SMTP Address: " & strSmtpAddress1)

objUser.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", array ("smtp:" &
strSmtpAddress2)
objUser.SetInfo
'LogMessage "Aggiunto SMTP Address: " & strSmtpAddress2
'WScript.Echo("Aggiunto SMTP Address: " & strSmtpAddress2)

End Function




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Sub Searchuser ()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function Searchuser (strSearchUser)

strConnect = "LDAP://" & DomainController
set oContainer = GetObject(strConnect)
searchpath = oContainer.ADsPath

set oConnect = CreateObject("ADODB.Connection")
set oCommand = CreateObject("ADODB.Command")

'apre la connessione
oConnect.Provider = "ADsDSOObject"
oConnect.Open "Active Directory Provider"

Set oCommand.ActiveConnection = oConnect

strCN = strSearchUser

oCommand.CommandText = "SELECT samAccountName FROM '" & searchpath
& "' WHERE objectClass='user' AND samAccountName = '" & strSearchUser
& "'"

set rs = oCommand.Execute


'scorre il record set

if rs.EOF and rs.BOF then
Searchuser = 0 ' Crea l'utente
else
Searchuser = 1 'non crea l'utente
end if

end Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Sub LogMessage()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub LogMessage(Msg)

'Apre il file di scrittura
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.OpenTextFile(strOutputFile,
OPEN_FILE_FOR_APPENDING,True)
'WScript.Echo msg
objOutputFile.WriteLine msg
objOutputFile.Close

End Sub

====================END: CreateUser-Mailbox.vbs=================