Dim RootDSE,mydomain,objRootDSE
strTitle="Nuevo Usuario de Mailbox"
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4
 
Dim WshShell, ret
Set WshShell = WScript.CreateObject("WScript.Shell")

Set objRootDSE = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://cn=Users," & objRootDSE.Get("defaultNamingContext"))

InputPrompt1 = "Nombre:"
name = InputBox(InputPrompt1, "Nombre.")
	strFirstName = name
	intFirstName = Len(strFirstName)
	strFirstLetter = UCase(Left(strFirstName, 1))
	strRemainingLetters = LCase(Right(strFirstName, intFirstName - 1))
	strFirstName = strFirstLetter & strRemainingLetters

InputPrompt2 = "Apellido:"
apellido = InputBox(InputPrompt2, "Apellido.")
	strFirst = apellido
	intFirst = Len(strFirst)
	strFirstLetter1 = UCase(Left(strFirst, 1))
	strRemainingLetters1 = LCase(Right(strFirst, intFirst - 1))
	strFirst = strFirstLetter1 & strRemainingLetters1

InputPrompt2 = "Interno:"
interno = InputBox(InputPrompt2, "interno.")

Set objUser = objContainer.Create("User", "cn=" & strFirstName & strLastName & " " & strFirst & strLast) 
    objUser.Put "sAMAccountName", LCase(Mid(name,1,1)) & LCase(apellido)
    objUser.Put "userAccountControl", intUAC XOR ADS_UF_ACCOUNTDISABLE
    objUser.Put "givenName", strFirstName & " " & strLastName
    objUser.Put "userprincipalname", LCase(Mid(name,1,1)) & LCase(apellido) & "@microsoft.com"
    objUser.Put "sn", strFirst & strLast
    objUser.Put "displayName", strFirstName & strLastName & " " & strFirst & strLast   
    objUser.Put "initials", UCase(Mid(name,1,1)) & UCase(Mid(apellido,1,1)) 
    objUser.Put "mail", LCase(Mid(name,1,1)) & LCase(apellido)  & "@microsoft.com"
    objUser.Put "pwdLastSet", -1
    objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD
    objUser.Put "telephoneNumber", UCase(interno)
    objUser.Put "scriptPath", "MS-LOGON.bat"
    objUser.Put "physicalDeliveryOfficeName", "RV o CB o LH" 
    objUser.Put "wWWHomePage", "http://www.microsoft.com" 
objUser.SetInfo
    objUser.SetPassword "pass*cambiar"
    
cuentadeusuario = LCase(Mid(name,1,1)) & LCase(apellido)
lab = """fest Lab"""
usr = """fest Users"""
usr = """USERS"""

set shell=createobject("wscript.shell")
shell.run "net localgroup users " & cuentadeusuario & " /add"
shell.run "net group fest_todos " & cuentadeusuario & " /add"
shell.run "net group " & lab & " " & cuentadeusuario & " /add"
shell.run "net group " & usr & " " & cuentadeusuario & " /add"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("\\chick\users\" & cuentadeusuario)

WScript.Echo "Usuario creado en forma exitosa:   " & cuentadeusuario & " Falta replicar los datos."

strMailDN=SelectMailStore
MakeMail objUser,strMailDN
Sub MakeMail(objUser,strMailDN)
On Error Resume next
Err.Clear	
objUser.CreateMailbox strMailDN
	If Err.Number <>0 Then
		f.WriteLine Now & " Error al crear el mailbox de: " & objUser.ADSPath & " on " & strMailDN 
		f.WriteLine Now & " " & Err.Number & " " & Err.Description
	Else
		objUser.SetInfo
		WScript.Echo "Mailbox creado para: " & objUser.Name
	End If
End Sub
Function SelectMailStore()
On Error Resume Next
Dim objRootDSE
Dim objConfiguration
Dim cat
Dim conn
Dim cmd
Dim RS
Dim objDict
Set objDict=CreateObject("scripting.dictionary")
Set objRootDSE = GetObject("LDAP://rootDSE")
x=1
strConfiguration = "LDAP://" & objRootDSE.Get("configurationNamingContext")
Set objConfiguration = GetObject(strConfiguration)
strQuery="Select name,cn,distinguishedname from '" & _
objConfiguration.ADSPath & "' Where objectclass='msExchPrivateMDB'"	
set cat=GetObject("GC:")
for each obj in cat
 set GC=obj
Next
AdsPath=GC.ADSPath
set conn=CreateObject("ADODB.Connection")
set cmd=CreateObject("ADODB.Command")
conn.Provider="ADSDSOObject"
conn.Open	
set cmd.ActiveConnection=conn
set RS=conn.Execute(strQuery)
do while not RS.EOF
	 DN=rs.Fields("distinguishedname")
	 CN=RS.Fields("cn")
	 NM=RS.Fields("name")
	objDict.Add x,DN
	strResults=strResults &"(" & x & ") " &DN & vbcrlf
	x=x+1
	 rs.movenext
Loop
rs.Close
conn.Close	
t=1
a=objDict.Items
	For i=0 To objDict.Count-1
	c=c & "(" & i+1 & ")" & a(i) & VbCrLf & vbcrlf
		 If t<>4 And i<>objDict.count-1 Then
		  t=t+1
		Else
		 MsgBox c,vbOKOnly,"Disponible buzón de: "
		 t=1
		 c=""
		End If
	 Next
iDN=Inputbox("Ingresar el numero del Mail store para usar. POR DEFECTO SERA EL NUMERO 1","Seleccionar el Store del Mail","1")
	If iDN = "" Then 
		WScript.Echo "Error inesperado..."
		WScript.Quit
	End If
If objDict.Exists(Int(iDN)) Then
	SelectMailStore=objDict.Item(Int(iDN))
Else
	rc=msgBox ("Numero seleccionado es invalido.",vbOKCancel+vbExclamation,"Seleccionar Store del Mail.")
	if rc=vbCancel Then
		wscript.Quit
	Else
		Main()
	End If
End If
Set objRootDSE=Nothing
Set objConfiguration=Nothing
Set cat=Nothing
Set conn=Nothing
Set cmd=Nothing
Set RS=Nothing
Set objDict=Nothing
End Function