With the help of my previous posts I have managed to produce a script that creates new AD users along with profile areas, user areas, login scripts and then emails notification that the account has been created. However the one problem that I am having is with the creation of the users mailbox. The script runs with no errors but doesnt create an e mail account.
I took my own data from the exchange server using the 'ldifde' tool and then incorporated it into the script but all that happens is that an e mail address is created under the Exchange General tab in the 'email admin' mmc instead of a mail storage box. I would really appreciate any help with this and have posted the code I have so far below (marked in red where the e mail creation should take place)
On Error resume
Dim strCont
strCont = InputBox("Type the corresponding number to the container that you want to use to create your new user in:" &vbcrlf & "1 - Site1 " &vbcrlf & "2 - Site2" &vbcrlf & "3 - Site3" &vbcrlf & "4 - Site4" & vbcrlf & "5 - City5" & vbcrlf & "6 - City2" & vbcrlf & "7 - City3" & vbcrlf & "8 - City4")
if strcont =""then
wscript.echo "You didn't enter a site number"
wscript.quit
end if
if strcont =>"9" then
wscript.echo "Site number does not exist!"
wscript.quit
end if
select case strCont
case"1"
strfshare = "server1"
strbuild = "Site1 "
strldap = "OU= Site1 ,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site1 "
strsecgrp = "HG_Site1"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"2"
strfshare = "server3"
strbuild = "Site2"
strldap = "OU= Site2,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site2"
strsecgrp = "HG_Site4"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"3"
strfshare = "server4"
strbuild = "Site3"
strldap = "OU= Site3,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site3"
strsecgrp = "Site3"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"4"
strfshare = "server2"
strbuild = "Site4"
strldap = "OU= Site4,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site4"
strsecgrp = "HG_Site4"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"5"
wscript.echo "This script will not currenlty work for City5 users, sorry!"
wscript.quit
'strfshare = "server8"
'strbuild = "City5"
'strldap = "OU=XP Users,OU=City5,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
'stroffice = "City5"
'strsecgrp = "HG_Site4"
'strdistlist = "CN=GRP: All my company In City5,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
'strctact = "Line manager 2@my company.com"
'strdatdrv = "e$"
case"6"
strfshare = "server5"
strbuild = "City2"
strldap = "OU=XP Users,OU=City2,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "City2"
strsecgrp = ""
strdistlist = "CN=GRP: All my company In City2,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "Line manager 2@my company.com"
strdatdrv = "d$"
case"7"
strfshare = "server6"
strbuild = "Moorland"
strldap = "OU=XP Users,OU=City3,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "City3"
strsecgrp = ""
strdistlist = "CN=GRP: All my company In City3,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"8"
strfshare = "server7"
strbuild = "City4"
strldap = "OU=XP Users,OU=City4,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "City4"
strsecgrp = ""
strdistlist = "CN=GRP: All my company In City4,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "Line manager 2@my company.com"
strdatdrv = "d$"
end select
firstname=inputbox("Type the users first name")
if firstname =""then
wscript.echo "You didn't enter a recognised name"
wscript.quit
end if
lastname1=inputbox("Type the users surname")
if lastname1 =""then
wscript.echo "You didn't enter a recognised surname"
wscript.quit
end if
lastname= UCase(lastname1)
initial = LCase(Left(firstName, 1))
initial2 = LCase(Left(firstName, 2))
username1 = LCase(left(lastName,6))
username = username1 & initial
bothName = firstName & " " & lastName
strdisplayname = lastname & " " & firstname & " -my company domain"
strdisplayname1 = lastname & ", " & firstname & " -my company domain"
dim strnames(7)
strnames(0)="OU= Site1 ,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(1)="OU= Site4,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(2)="OU= Site3,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(3)="OU= Site2,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(4)="OU= XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(5)="OU= Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(6)="OU= XP Users,OU=City5,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(7)="OU= Users,OU=City5,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
for i= 0 to 7
Set objDomain = GetObject("LDAP://" & strnames(i))
For Each objUser In objDomain
If UCase(objUser.sAMAccountName) = UCase(username) Then
'wscript.echo "Username : " & username & " is already being used in the Active Directory."
initial = LCase(Left(firstName, 2))
username1 = LCase(left(lastName,6))
username = username1 & initial
Exit For
End If
Next
next
wscript.echo "Your user has been given the following username: " & username
'This part of the script creates the user account on the server
set objParent = GetObject("LDAP://" & strldap)
set objUser = objParent.Create("user", "cn=" & strdisplayname)
objUser.Put "sAMAccountName", "" & username
objUser.Put "userPrincipalName", "" & username & "@domain.intra.my company.com"
objUser.Put "givenName", "" & firstname
objUser.Put "sn", "" & lastname1
objUser.Put "displayName", "" & strdisplayname1
objuser.Put "physicalDeliveryOfficeName", "" & stroffice
objuser.Put "Description" ,"New user: " & Date
objuser.Put "scriptPath", "pilot.syn"
objUser.TerminalServicesProfilePath = "\\" & strfshare & "\profiles.$\" & username & "\terminal"
objUser.mail = firstname & "." & lastname1 & "@my company.com"
objUser.SetInfo
objUser.SetPassword "password"
objUser.AccountDisabled = TRUE
objuser.setinfo
If err.number <> 0 then wscript.echo "Problems encountered whilst creating this user please check the active directory"
strexsvr = InputBox("Type the Exchange server that you want to create accounts for " & vbcrlf & "(i.e. 11 or 12)")
if strexsvr =""then wscript.quit
select case strexsvr
case"11"
strstgrp = "CN=EigthStorageGroup"
case"12"
strstgrp = "CN=FourthStorageGroup"
end select
dim max,min
max=6
min=1
strdb =(Int((max-min+1)*Rnd+min))
Set objMailbox = objUser
objMailbox.Create "Mailbox","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"
objMailbox.SetInfo
If err.number <> 0 then wscript.echo "Problems encountered whilst creating this users mailbox entry"
Set objGroup1 = GetObject ("LDAP://CN=GRP: XP Desktop Users,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com")
objGroup1.Add objUser.ADsPath
Set objGroup2 = GetObject ("LDAP://" & strdistlist )
objGroup2.Add objUser.ADsPath
Set objGroup3 = GetObject ("LDAP://CN=" & strsecgrp & ",OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com")
objGroup3.Add objUser.ADsPath
Wscript.Sleep(1000)
strgrpadd = msgbox("Do you want to add your user to any groups?" & vbcrlf & "You are not able to add Mail Boxes or distribution lists at this point",vbyesno)
Select case strgrpadd
case vbyes
strhwmany = InputBox("How many groups would you like to add" & vbcrlf & "(type a number)")
for i = 0 to hwmany
strgroup1 = InputBox("Enter the group name that you want to add your user to....." & vbcrlf & "Groups must have their full names entered" & vbcrlf & "i.e. " ap_msproject2002" & vbcrlf & " ap_Job ref2002" & vbcrlf & "ap_msproject2002" & vbcrlf & " ap_msvisiopro2002" & vbcrlf & " ap_msfrontpage2002" & vbcrlf & " ap_consolidator_10" & vbcrlf & " ap_shiva")
sDUser="WinNT://domain/"& username &",user"
set oLGroup=getobject("WinNT://domain/" & strgroup1)
If err.number <> 0 then wscript.echo "Can not find this group so " & username & " has not been added"
oLGroup.add sDUser
wscript.echo "" & username & " has been added to " & strgroup1
next
case vbno
end select
'This part of the script creates the U drive and Profile area on the appropriate fileshare server
dim funct, copy
set funct = CreateObject ("Scripting.FileSystemObject")
If funct.FolderExists("\\" & strfshare & "\" & strdatdrv & "\Profiles\" & username) Then
wscript.echo "A profile already exists for a user with this name "
Else
set copy = funct.GetFolder("\\" & strfshare & "\" & strdatdrv & "\Profiles\@Sample")
copy.Copy("\\" & strfshare & "\" & strdatdrv & "\Profiles\" & username)
End If
dim funct2, copy2
set funct2 = CreateObject ("Scripting.FileSystemObject")
If funct2.FolderExists("\\" & strfshare & "\" & strdatdrv & "\Users\" & username) Then
wscript.echo "A user area already exists for a user with this name "
Else
set copy2 = funct2.GetFolder("\\" & strfshare & "\" & strdatdrv & "\Users\@Sample")
copy2.Copy("\\" & strfshare & "\" & strdatdrv & "\Users\" & username)
End If
dim functa, copya
set functa = CreateObject ("Scripting.FileSystemObject")
If functa.FileExists("\\" & strfshare & "\" & strdatdrv & "\Users\#Scripts\" & username & ".kix") Then
wscript.echo "A kix script already exists for a user with this name "
Else
set copya = functa.GetFile("\\" & strfshare & "\" & strdatdrv & "\Users\#Scripts\@sample.kix")
copya.Copy("\\" & strfshare & "\" & strdatdrv & "\Users\#Scripts\" & username & ".kix")
End If
strmpdrv = msgbox("Do you want to add any drive mappings to your users kix file?",vbyesno)
select case strmpdrv
case vbyes
Set oShell = WScript.CreateObject ("WScript.shell")
oShell.run "\\" & strfshare & "\" & strdatdrv & "\users\#scripts"
case vbno
end select
Dim strusrtype
strusrtype = msgbox("Is this user from the weekly new starters spreadsheet?",vbyesno)
Select case strusrtype
case vbyes
strName = "New starters spreadsheet"
strgrps = "Standard Desktop Apps"
strUser = bothName
If strUser = "" Then WScript.Quit(1)
strUsrnm = userName
If strUsrnm = "" Then WScript.Quit(1)
strvgd = Inputbox("Enter the Job ref Number")
If strvgd = "" Then WScript.Quit(1)
Set WshNetwork = WScript.CreateObject("WScript.Network")
'Creates a text file for each new user and populates it
Dim fso, MyFile
strnm2=replace(strname,"."," ")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("\\server2\d$\data\City2newusers\" & strUsrNm & ".txt", False)
MyFile.WriteLine("---------------" & strUser & "---------------" & vbcrlf & vbcrlf &"Username: " & strUsrnm & vbcrlf & "Was created on: "& Date &" at: "& Time & vbcrlf &"The requestor was: " & strname & vbcrlf &"The Job ref reference number is: " & strvgd & vbcrlf & "Created by: " & wshnetwork.username & vbcrlf & "Accounts have ben created on:" & strfshare & vbcrlf & "Exchange account shave been created on: exchange server-" & strexsvr & " (DB Group" & strdb & ")" & vbcrlf &" ---------------END OF REPORT---------------")
MyFile.Close
Set myOlApp = CreateObject("Outlook.Application")
Set myItem2 = myOlApp.CreateItem(olMailItem)
'myItem2.Display
myItem2.To = strctact
myItem2.Subject = "Notification of new account creation for " & strUser & " Job ref number: " & strvgd
myItem2.Body = "New accounts have been created for " & struser & " with username: " & strusrnm & "." & vbcrlf &"These were sent from the " & strnm2
myItem2.Save
' myItem2.send
'Creates an entry in a spreadsheet for each new user
Dim appexcel, wb
Set appexcel = WScript.CreateObject("Excel.Application")
With appexcel
'.Visible = True
Set wb=.Workbooks.Open("\\server2\d$\data\City2newusers\newuser.xls")
r = 1
Do Until Len(.Cells(r, 1).Value) = 0
r = r + 1
Loop
.Cells(r, 1).Value = strUser
.Cells(r, 2).Value = strUsrNm
.Cells(r, 3).Value = strgrps
.Cells(r, 4).Value = strvgd
.Cells(r, 5).Value = strname
.Cells(r, 6).Value = date
.Cells(r, 7).Value = time
.Cells(r, 8).Value = wshnetwork.username
wb.Save
Set wb = Nothing
.Quit
End With
Set appexcel = Nothing
case vbno
Dim strName2
Dim strMessage2
strName2 = Inputbox("Enter the email address of the person who requested the accounts i.e. joe.bloggs or line.manager:")
If strName2 = "" Then WScript.Quit(1)
strUser2 = bothname
If strUser2 = "" Then WScript.Quit(1)
strUsrnm2 = userName
If strUsrnm2 = "" Then WScript.Quit(1)
stracc = msgbox("Was any further network access requested?", vbyesno)
If stracc=vbYes Then
strgrps2 = Inputbox("Enter any access that has been granted to the user")
Else
strgrps2 = "(No special access was requested)"
end if
strvgd2 = Inputbox("Enter the Job ref Number")
If strvgd2 = "" Then WScript.Quit(1)
Set WshNetwork = WScript.CreateObject("WScript.Network")
'Creates a text file for each new user and populates it
Dim fso1, myfile1
strnm3=replace(strName2,"."," ")
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set myfile1 = fso1.CreateTextFile("\\server2\d$\data\City2newusers\" & strUsrnm2 & ".txt", False)
myfile1.WriteLine("---------------" & strUser2 & "---------------" & vbcrlf & vbcrlf &"Username: " & strUsrnm2 & vbcrlf & "Was created on: "& Date &" at: "& Time & vbcrlf &"The requestor was: " & strnm3 & vbcrlf &"The Job ref reference number is: " & strvgd2 & vbcrlf & "Created by: " & wshnetwork.username & vbcrlf & "Accounts have ben created on:" & strfshare & vbcrlf & "Exchange account shave been created on: exchange server-" & strexsvr & " (DB Group" & strdb & ")" & vbcrlf &" ---------------END OF REPORT---------------")
myfile1.Close
'Creates instance of outlook and sends requestor an e mail
Set myolApp2 = CreateObject("Outlook.Application")
Set myitem3 = myolApp2.CreateItem(olMailItem)
'myitem3.Display
myitem3.To = "" & strName2 & "@my company.com"
myitem3.Subject = "Notification of new account creation for " & strUser2
myitem3.Body = "As per your request new XP accounts have now been created for: " & strUser2 &vbcrlf & vbcrlf &"Logon credentials are as follows:" & vbcrlf & vbcrlf &"Username- " & strUsrnm2 & vbcrlf & "Password- newpass" & vbcrlf & vbcrlf & strUser2 & " also has access to: " & strgrps2 & vbcrlf & strUser2 &"'s account will be disabled until ISG have received a confidentiality form" & vbcrlf & vbcrlf & "Regards" & vbcrlf & vbcrlf & "City1 ISG"
myitem3.Save
' myitem3.send
Set myitem32 = myolApp2.CreateItem(olMailItem)
'myitem32.Display
myitem32.To = strctact
myitem32.Subject = "Notification of new account creation for " & strUser2 & " Job ref number: " & strvgd2
myitem32.Body = "New accounts have been created for " & strUser2 & " with username: " & strUsrnm2 & "." & vbcrlf &"The requestor was: " & strnm3 & vbcrlf & "The accounts have been disabled until you receive a confidentiality agreement" & vbcrlf & strUser2 & " also has access to: " & strgrps2 & vbcrlf & strnm3 & " has been informed"
myitem32.Save
' myitem32.send
'Creates an entry in a spreadsheet for each new user
Dim appexcel2, wb2
Set appexcel2 = WScript.CreateObject("Excel.Application")
With appexcel2
'.Visible = True
Set wb2=.Workbooks.Open("\\server2\d$\data\City2newusers\newuser.xls")
r = 1
Do Until Len(.Cells(r, 1).Value) = 0
r = r + 1
Loop
.Cells(r, 1).Value = strUser2
.Cells(r, 2).Value = strUsrnm2
.Cells(r, 3).Value = strgrps2
.Cells(r, 4).Value = strvgd2
.Cells(r, 5).Value = strnm3
.Cells(r, 6).Value = date
.Cells(r, 7).Value = time
.Cells(r, 8).Value = wshnetwork.username
wb2.Save
Set wb2 = Nothing
.Quit
End With
Set appexcel2 = Nothing
end select
'Creates copy of the newusers directory from the server and puts it in the root of the local machines c drive
srcdir="\\server2\d$\data\City2newusers\"
destdir="C:\"
Set SA=CreateObject("Shell.Application")
Set NS=SA.NameSpace(destdir)
NS.CopyHere srcdir,16
wscript.echo "Done!"
Many thanks in advance of any helpful suggestions as this will finish off what has been a very lenghty lesson in script writing for me
I took my own data from the exchange server using the 'ldifde' tool and then incorporated it into the script but all that happens is that an e mail address is created under the Exchange General tab in the 'email admin' mmc instead of a mail storage box. I would really appreciate any help with this and have posted the code I have so far below (marked in red where the e mail creation should take place)
On Error resume
Dim strCont
strCont = InputBox("Type the corresponding number to the container that you want to use to create your new user in:" &vbcrlf & "1 - Site1 " &vbcrlf & "2 - Site2" &vbcrlf & "3 - Site3" &vbcrlf & "4 - Site4" & vbcrlf & "5 - City5" & vbcrlf & "6 - City2" & vbcrlf & "7 - City3" & vbcrlf & "8 - City4")
if strcont =""then
wscript.echo "You didn't enter a site number"
wscript.quit
end if
if strcont =>"9" then
wscript.echo "Site number does not exist!"
wscript.quit
end if
select case strCont
case"1"
strfshare = "server1"
strbuild = "Site1 "
strldap = "OU= Site1 ,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site1 "
strsecgrp = "HG_Site1"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"2"
strfshare = "server3"
strbuild = "Site2"
strldap = "OU= Site2,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site2"
strsecgrp = "HG_Site4"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"3"
strfshare = "server4"
strbuild = "Site3"
strldap = "OU= Site3,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site3"
strsecgrp = "Site3"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"4"
strfshare = "server2"
strbuild = "Site4"
strldap = "OU= Site4,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "Site4"
strsecgrp = "HG_Site4"
strdistlist = "CN=GRP: All my company In City1,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"5"
wscript.echo "This script will not currenlty work for City5 users, sorry!"
wscript.quit
'strfshare = "server8"
'strbuild = "City5"
'strldap = "OU=XP Users,OU=City5,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
'stroffice = "City5"
'strsecgrp = "HG_Site4"
'strdistlist = "CN=GRP: All my company In City5,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
'strctact = "Line manager 2@my company.com"
'strdatdrv = "e$"
case"6"
strfshare = "server5"
strbuild = "City2"
strldap = "OU=XP Users,OU=City2,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "City2"
strsecgrp = ""
strdistlist = "CN=GRP: All my company In City2,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "Line manager 2@my company.com"
strdatdrv = "d$"
case"7"
strfshare = "server6"
strbuild = "Moorland"
strldap = "OU=XP Users,OU=City3,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "City3"
strsecgrp = ""
strdistlist = "CN=GRP: All my company In City3,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "line manager@my company.com"
strdatdrv = "d$"
case"8"
strfshare = "server7"
strbuild = "City4"
strldap = "OU=XP Users,OU=City4,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
stroffice = "City4"
strsecgrp = ""
strdistlist = "CN=GRP: All my company In City4,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com"
strctact = "Line manager 2@my company.com"
strdatdrv = "d$"
end select
firstname=inputbox("Type the users first name")
if firstname =""then
wscript.echo "You didn't enter a recognised name"
wscript.quit
end if
lastname1=inputbox("Type the users surname")
if lastname1 =""then
wscript.echo "You didn't enter a recognised surname"
wscript.quit
end if
lastname= UCase(lastname1)
initial = LCase(Left(firstName, 1))
initial2 = LCase(Left(firstName, 2))
username1 = LCase(left(lastName,6))
username = username1 & initial
bothName = firstName & " " & lastName
strdisplayname = lastname & " " & firstname & " -my company domain"
strdisplayname1 = lastname & ", " & firstname & " -my company domain"
dim strnames(7)
strnames(0)="OU= Site1 ,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(1)="OU= Site4,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(2)="OU= Site3,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(3)="OU= Site2,OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(4)="OU= XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(5)="OU= Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(6)="OU= XP Users,OU=City5,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
strnames(7)="OU= Users,OU=City5,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com"
for i= 0 to 7
Set objDomain = GetObject("LDAP://" & strnames(i))
For Each objUser In objDomain
If UCase(objUser.sAMAccountName) = UCase(username) Then
'wscript.echo "Username : " & username & " is already being used in the Active Directory."
initial = LCase(Left(firstName, 2))
username1 = LCase(left(lastName,6))
username = username1 & initial
Exit For
End If
Next
next
wscript.echo "Your user has been given the following username: " & username
'This part of the script creates the user account on the server
set objParent = GetObject("LDAP://" & strldap)
set objUser = objParent.Create("user", "cn=" & strdisplayname)
objUser.Put "sAMAccountName", "" & username
objUser.Put "userPrincipalName", "" & username & "@domain.intra.my company.com"
objUser.Put "givenName", "" & firstname
objUser.Put "sn", "" & lastname1
objUser.Put "displayName", "" & strdisplayname1
objuser.Put "physicalDeliveryOfficeName", "" & stroffice
objuser.Put "Description" ,"New user: " & Date
objuser.Put "scriptPath", "pilot.syn"
objUser.TerminalServicesProfilePath = "\\" & strfshare & "\profiles.$\" & username & "\terminal"
objUser.mail = firstname & "." & lastname1 & "@my company.com"
objUser.SetInfo
objUser.SetPassword "password"
objUser.AccountDisabled = TRUE
objuser.setinfo
If err.number <> 0 then wscript.echo "Problems encountered whilst creating this user please check the active directory"
strexsvr = InputBox("Type the Exchange server that you want to create accounts for " & vbcrlf & "(i.e. 11 or 12)")
if strexsvr =""then wscript.quit
select case strexsvr
case"11"
strstgrp = "CN=EigthStorageGroup"
case"12"
strstgrp = "CN=FourthStorageGroup"
end select
dim max,min
max=6
min=1
strdb =(Int((max-min+1)*Rnd+min))
Set objMailbox = objUser
objMailbox.Create "Mailbox","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"
objMailbox.SetInfo
If err.number <> 0 then wscript.echo "Problems encountered whilst creating this users mailbox entry"
Set objGroup1 = GetObject ("LDAP://CN=GRP: XP Desktop Users,OU=Distribution Lists,OU=Groups,DC=domain,DC=intra,DC=my company,DC=com")
objGroup1.Add objUser.ADsPath
Set objGroup2 = GetObject ("LDAP://" & strdistlist )
objGroup2.Add objUser.ADsPath
Set objGroup3 = GetObject ("LDAP://CN=" & strsecgrp & ",OU=XP Users,OU=City1,OU=Sites,DC=domain,DC=intra,DC=my company,DC=com")
objGroup3.Add objUser.ADsPath
Wscript.Sleep(1000)
strgrpadd = msgbox("Do you want to add your user to any groups?" & vbcrlf & "You are not able to add Mail Boxes or distribution lists at this point",vbyesno)
Select case strgrpadd
case vbyes
strhwmany = InputBox("How many groups would you like to add" & vbcrlf & "(type a number)")
for i = 0 to hwmany
strgroup1 = InputBox("Enter the group name that you want to add your user to....." & vbcrlf & "Groups must have their full names entered" & vbcrlf & "i.e. " ap_msproject2002" & vbcrlf & " ap_Job ref2002" & vbcrlf & "ap_msproject2002" & vbcrlf & " ap_msvisiopro2002" & vbcrlf & " ap_msfrontpage2002" & vbcrlf & " ap_consolidator_10" & vbcrlf & " ap_shiva")
sDUser="WinNT://domain/"& username &",user"
set oLGroup=getobject("WinNT://domain/" & strgroup1)
If err.number <> 0 then wscript.echo "Can not find this group so " & username & " has not been added"
oLGroup.add sDUser
wscript.echo "" & username & " has been added to " & strgroup1
next
case vbno
end select
'This part of the script creates the U drive and Profile area on the appropriate fileshare server
dim funct, copy
set funct = CreateObject ("Scripting.FileSystemObject")
If funct.FolderExists("\\" & strfshare & "\" & strdatdrv & "\Profiles\" & username) Then
wscript.echo "A profile already exists for a user with this name "
Else
set copy = funct.GetFolder("\\" & strfshare & "\" & strdatdrv & "\Profiles\@Sample")
copy.Copy("\\" & strfshare & "\" & strdatdrv & "\Profiles\" & username)
End If
dim funct2, copy2
set funct2 = CreateObject ("Scripting.FileSystemObject")
If funct2.FolderExists("\\" & strfshare & "\" & strdatdrv & "\Users\" & username) Then
wscript.echo "A user area already exists for a user with this name "
Else
set copy2 = funct2.GetFolder("\\" & strfshare & "\" & strdatdrv & "\Users\@Sample")
copy2.Copy("\\" & strfshare & "\" & strdatdrv & "\Users\" & username)
End If
dim functa, copya
set functa = CreateObject ("Scripting.FileSystemObject")
If functa.FileExists("\\" & strfshare & "\" & strdatdrv & "\Users\#Scripts\" & username & ".kix") Then
wscript.echo "A kix script already exists for a user with this name "
Else
set copya = functa.GetFile("\\" & strfshare & "\" & strdatdrv & "\Users\#Scripts\@sample.kix")
copya.Copy("\\" & strfshare & "\" & strdatdrv & "\Users\#Scripts\" & username & ".kix")
End If
strmpdrv = msgbox("Do you want to add any drive mappings to your users kix file?",vbyesno)
select case strmpdrv
case vbyes
Set oShell = WScript.CreateObject ("WScript.shell")
oShell.run "\\" & strfshare & "\" & strdatdrv & "\users\#scripts"
case vbno
end select
Dim strusrtype
strusrtype = msgbox("Is this user from the weekly new starters spreadsheet?",vbyesno)
Select case strusrtype
case vbyes
strName = "New starters spreadsheet"
strgrps = "Standard Desktop Apps"
strUser = bothName
If strUser = "" Then WScript.Quit(1)
strUsrnm = userName
If strUsrnm = "" Then WScript.Quit(1)
strvgd = Inputbox("Enter the Job ref Number")
If strvgd = "" Then WScript.Quit(1)
Set WshNetwork = WScript.CreateObject("WScript.Network")
'Creates a text file for each new user and populates it
Dim fso, MyFile
strnm2=replace(strname,"."," ")
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("\\server2\d$\data\City2newusers\" & strUsrNm & ".txt", False)
MyFile.WriteLine("---------------" & strUser & "---------------" & vbcrlf & vbcrlf &"Username: " & strUsrnm & vbcrlf & "Was created on: "& Date &" at: "& Time & vbcrlf &"The requestor was: " & strname & vbcrlf &"The Job ref reference number is: " & strvgd & vbcrlf & "Created by: " & wshnetwork.username & vbcrlf & "Accounts have ben created on:" & strfshare & vbcrlf & "Exchange account shave been created on: exchange server-" & strexsvr & " (DB Group" & strdb & ")" & vbcrlf &" ---------------END OF REPORT---------------")
MyFile.Close
Set myOlApp = CreateObject("Outlook.Application")
Set myItem2 = myOlApp.CreateItem(olMailItem)
'myItem2.Display
myItem2.To = strctact
myItem2.Subject = "Notification of new account creation for " & strUser & " Job ref number: " & strvgd
myItem2.Body = "New accounts have been created for " & struser & " with username: " & strusrnm & "." & vbcrlf &"These were sent from the " & strnm2
myItem2.Save
' myItem2.send
'Creates an entry in a spreadsheet for each new user
Dim appexcel, wb
Set appexcel = WScript.CreateObject("Excel.Application")
With appexcel
'.Visible = True
Set wb=.Workbooks.Open("\\server2\d$\data\City2newusers\newuser.xls")
r = 1
Do Until Len(.Cells(r, 1).Value) = 0
r = r + 1
Loop
.Cells(r, 1).Value = strUser
.Cells(r, 2).Value = strUsrNm
.Cells(r, 3).Value = strgrps
.Cells(r, 4).Value = strvgd
.Cells(r, 5).Value = strname
.Cells(r, 6).Value = date
.Cells(r, 7).Value = time
.Cells(r, 8).Value = wshnetwork.username
wb.Save
Set wb = Nothing
.Quit
End With
Set appexcel = Nothing
case vbno
Dim strName2
Dim strMessage2
strName2 = Inputbox("Enter the email address of the person who requested the accounts i.e. joe.bloggs or line.manager:")
If strName2 = "" Then WScript.Quit(1)
strUser2 = bothname
If strUser2 = "" Then WScript.Quit(1)
strUsrnm2 = userName
If strUsrnm2 = "" Then WScript.Quit(1)
stracc = msgbox("Was any further network access requested?", vbyesno)
If stracc=vbYes Then
strgrps2 = Inputbox("Enter any access that has been granted to the user")
Else
strgrps2 = "(No special access was requested)"
end if
strvgd2 = Inputbox("Enter the Job ref Number")
If strvgd2 = "" Then WScript.Quit(1)
Set WshNetwork = WScript.CreateObject("WScript.Network")
'Creates a text file for each new user and populates it
Dim fso1, myfile1
strnm3=replace(strName2,"."," ")
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set myfile1 = fso1.CreateTextFile("\\server2\d$\data\City2newusers\" & strUsrnm2 & ".txt", False)
myfile1.WriteLine("---------------" & strUser2 & "---------------" & vbcrlf & vbcrlf &"Username: " & strUsrnm2 & vbcrlf & "Was created on: "& Date &" at: "& Time & vbcrlf &"The requestor was: " & strnm3 & vbcrlf &"The Job ref reference number is: " & strvgd2 & vbcrlf & "Created by: " & wshnetwork.username & vbcrlf & "Accounts have ben created on:" & strfshare & vbcrlf & "Exchange account shave been created on: exchange server-" & strexsvr & " (DB Group" & strdb & ")" & vbcrlf &" ---------------END OF REPORT---------------")
myfile1.Close
'Creates instance of outlook and sends requestor an e mail
Set myolApp2 = CreateObject("Outlook.Application")
Set myitem3 = myolApp2.CreateItem(olMailItem)
'myitem3.Display
myitem3.To = "" & strName2 & "@my company.com"
myitem3.Subject = "Notification of new account creation for " & strUser2
myitem3.Body = "As per your request new XP accounts have now been created for: " & strUser2 &vbcrlf & vbcrlf &"Logon credentials are as follows:" & vbcrlf & vbcrlf &"Username- " & strUsrnm2 & vbcrlf & "Password- newpass" & vbcrlf & vbcrlf & strUser2 & " also has access to: " & strgrps2 & vbcrlf & strUser2 &"'s account will be disabled until ISG have received a confidentiality form" & vbcrlf & vbcrlf & "Regards" & vbcrlf & vbcrlf & "City1 ISG"
myitem3.Save
' myitem3.send
Set myitem32 = myolApp2.CreateItem(olMailItem)
'myitem32.Display
myitem32.To = strctact
myitem32.Subject = "Notification of new account creation for " & strUser2 & " Job ref number: " & strvgd2
myitem32.Body = "New accounts have been created for " & strUser2 & " with username: " & strUsrnm2 & "." & vbcrlf &"The requestor was: " & strnm3 & vbcrlf & "The accounts have been disabled until you receive a confidentiality agreement" & vbcrlf & strUser2 & " also has access to: " & strgrps2 & vbcrlf & strnm3 & " has been informed"
myitem32.Save
' myitem32.send
'Creates an entry in a spreadsheet for each new user
Dim appexcel2, wb2
Set appexcel2 = WScript.CreateObject("Excel.Application")
With appexcel2
'.Visible = True
Set wb2=.Workbooks.Open("\\server2\d$\data\City2newusers\newuser.xls")
r = 1
Do Until Len(.Cells(r, 1).Value) = 0
r = r + 1
Loop
.Cells(r, 1).Value = strUser2
.Cells(r, 2).Value = strUsrnm2
.Cells(r, 3).Value = strgrps2
.Cells(r, 4).Value = strvgd2
.Cells(r, 5).Value = strnm3
.Cells(r, 6).Value = date
.Cells(r, 7).Value = time
.Cells(r, 8).Value = wshnetwork.username
wb2.Save
Set wb2 = Nothing
.Quit
End With
Set appexcel2 = Nothing
end select
'Creates copy of the newusers directory from the server and puts it in the root of the local machines c drive
srcdir="\\server2\d$\data\City2newusers\"
destdir="C:\"
Set SA=CreateObject("Shell.Application")
Set NS=SA.NameSpace(destdir)
NS.CopyHere srcdir,16
wscript.echo "Done!"
Many thanks in advance of any helpful suggestions as this will finish off what has been a very lenghty lesson in script writing for me