Board index » Visual Studio » Solution: Active Directory, create User, with mailbox and SMTP Address from Exel file

Visual Studio347
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=================


-