Hello,
I've gotten the "Exchange New User Demo" script working that Jhicks had posted in the script vault.
What I'm trying to do now is pull users from a list, instead of using the input boxes.
I add this to the script
Set oTS = oFS.OpenTextFile("c:users.txt")Do Until oTS.atendofstreamstrUser = oTS.ReadLine
Loop
I get an error at the first Sub routine then. This is probably a noob question but I can't figure out where to go from here.
Thanks for any help!
Exchange New User from file
Forum rules
Do not post any licensing information in this forum.
Any code longer than three lines should be added as code using the 'Select Code' dropdown menu or attached as a file.
Do not post any licensing information in this forum.
Any code longer than three lines should be added as code using the 'Select Code' dropdown menu or attached as a file.
Exchange New User from file
The users.txt includes the user name (firstname.lastname) on each line.
The script currently takes the user name from the Inputbox to define the strUser and a function get the UserDN (distinguished name) for the creation of the mailbox.
The problem seems to be with the Do Until oTS.atendofstream as soon as I take that out I no longer get a syntax error on the sub routine.
Does that answer your questions?
Thanks again
The script currently takes the user name from the Inputbox to define the strUser and a function get the UserDN (distinguished name) for the creation of the mailbox.
The problem seems to be with the Do Until oTS.atendofstream as soon as I take that out I no longer get a syntax error on the sub routine.
Does that answer your questions?
Thanks again
Exchange New User from file
Be sure teh file has not been saved as UNICODE. Also be sure that the line terminators are correct. Use a test file created with notepad with one or two users in it to get the script working.
Exchange New User from file
I've posted the original script below, it creates an exchange mailbox, and creates a folder on a network server for the user.
To pull the user names from the list I added
Set oFS = CreateObject("Scripting.FileSystemObject")Set oTS = oFS.OpenTextFile("c:users.txt")Do Until oTS.AtEndOfStream
sUser = oTS.ReadLine
Loop
I then changed the variable strUser to strUser=sUser
Thanks for all of your help, this is the first big script that I've tried to tackle since Techmentor....
To pull the user names from the list I added
Set oFS = CreateObject("Scripting.FileSystemObject")Set oTS = oFS.OpenTextFile("c:users.txt")Do Until oTS.AtEndOfStream
sUser = oTS.ReadLine
Loop
I then changed the variable strUser to strUser=sUser
Thanks for all of your help, this is the first big script that I've tried to tackle since Techmentor....
Code: Select all
On Error Resume Next
strTitle="Create Mailbox and Network Folder"
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_UPDATE = 2
strUser=InputBox("What is the User Name? Example:john.doe",strTitle,"john.doe")
strJob=InputBox("create folder in studentData or netfolder?","User Type","studentdata")
strHomeSrv="storage"
strHomeLetter="H:"
strUsersDir="v:"
strLocalPath="v:" 'this is local to the file server
'get user's distinguished name
strUserDN=GetDN(strUser)
If strUserDN = "NotFound" Then
WScript.Echo strUser & " not found"
WScript.Quit
End If
Set objUser=GetObject("LDAP://" & strUserDN)
Set objGroup = GetObject("LDAP://CN=CurrentStudents,OU=Students,OU=Simpson College,DC=sc,DC=loc")
If strJob="studentdata" Then
objGroup.PutEx ADS_PROPERTY_APPEND, "member", array(strUserDN)
objGroup.SetInfo
End If
'WScript.Echo "group membership has been set"
MakeHomeDrive objUser,strHomeLetter,strLocalPath,strHomeSrv,strUsersDir,strUser
'///////////////////////////////////////////
'Create User's Home Folder
'///////////////////////////////////////////
Sub MakeHomeDrive(objUser,strHomeLetter,strLocalPath,strHomeSrv,strUsersDir,strUserName)
On Error Resume Next
Err.Clear
'sample values
'strHomeLetter="H:"
'what is the local path on the server where the share will be created?
'strLocalPath="c:users"
'strHomeSrv="ITSERVER1"
'strUserName="jhicks" 'usually the user's SAMAccount name
'strUsersDir="itserver1users$"
'Dim fso,objNetwork,objShell
'objUser.HomeDrive=strHomeLetter
'objUser.HomeDirectory="" & strHomeSrv & "" & strUserName & "$"
'objUser.Profile="" & strHomeSrv & "" & strUserName & "$"
'objUser.SetInfo
Set fso=CreateObject("Scripting.FileSystemObject")
Set objNetwork=CreateObject("WScript.Network")
Set objShell=CreateObject("WScript.Shell")
objNetwork.MapNetworkDrive "v:","" & strHomeSrv & "" & strJob
'WScript.Echo Now & " Creating " & strUsersDir & "" & strUserName
fso.CreateFolder(strUsersDir & "" & strUserName)
If Err.Number<>0 Then
WScript.echo Now & " Error creating network folder"
wscript.Echo Now & " " & Err.Number & " " & Err.Description
Else
'share the new home directory
'wscript.Echo Now & " Created home directory " &strHomeSrv & "" & strUserName
dim objNewShare, objSrv
'wscript.Echo Now & " Creating share"
'set objSrv=GetObject("WinNT://" & strHomeSrv & "/LanManServer")
'set objNewShare=objSrv.Create("fileshare",strUserName & "$")
'objNewShare.Path=strLocalPath & "" & strUserName
'objNewShare.MaxUserCount=2
'objNewShare.SetInfo
'wscript.Echo Now & " finished creating share"
'you may need to give the service a moment or two to finish this process
'before continuing. The sleep time is in milliseconds.
wscript.Sleep 1000
'we need to temporarily map a drive to the user's new directory so we
'can set permissions
'uncomment next line for debugging
'WScript.echo now & " Mapping X: to " & ""&strHomeSrv & "netfolder" & strUserName
objNetwork.MapNetworkDrive "w:","" & strHomeSrv & "" & strJob & "" & strUserName
'WScript.echo Now & " running CACLS"
'set permissions
'windows are hidden. Change 0 to 1 to see windows
objShell.Run "cmd /c echo y|cacls w: /g Administrators:F",0,True
objShell.Run "cacls w: /e /g " & objNetwork.UserDomain & "" & strUserName & ":F",0,True
objShell.Run "cacls w: /e /g System:F",0,True
'uncomment for debugging
'wscript.Echo Now & " Finished Creating Folder"
'drop network connection
objNetwork.RemoveNetworkDrive "w:",True
objNetwork.RemoveNetworkDrive "v:",True
End If
End Sub
'\\\\\\\
' Get user's distinguishedname
'\\\\\\\
Function GetDN(samAccount)
'Given NT4 account name, find the distinguished name for the user account
'On Error Resume Next
Dim conn,cmd,RS
Set conn=CreateObject("ADODB.Connection")
Set cmd=CreateObject("ADODB.Command")
GetDN="NotFound"
Set RootDSE=GetObject("LDAP://RootDSE")
Set myDomain=GetObject("LDAP://"&RootDSE.get("DefaultNamingContext"))
strQuery="Select sAMAccountname,distinguishedname from '" & _
myDomain.AdsPath & "' Where objectcategory='person' AND objectclass='user'" & _
" AND sAMAccountName='" & samAccount & "'"
set cat=GetObject("GC:")
for Each obj In cat
Set GC=obj
Next
conn.Provider="ADSDSOObject"
conn.Open "Active Directory Provider"
cmd.ActiveConnection=conn
cmd.Properties("Page Size") = 100
cmd.Properties("asynchronous")=True
cmd.Properties("Timeout") =30
cmd.Properties("Cache Results") = false
cmd.CommandText=strQuery
set RS=cmd.Execute
'if an empty record set is returned, exit the function
If RS.BOF And RS.EOF Then
GetDN="NotFound"
Exit Function
End if
do While not RS.EOF
GetDN=rs.Fields("distinguishedname")
rs.movenext
Loop
rs.Close
conn.Close
End Function
'Create the mailbox in Exchange
Dim RootDSE,mydomain
strTitle="New User Demo"
set RootDSE=GetObject("LDAP://RootDSE")
set mydomain=GetObject("LDAP://"&RootDSE.get("DefaultNamingContext"))
myDomainADSPath=mydomain.ADSPath 'LDAP://DC=Mydomain,DC=local
myDomainPath=MID(mydomain.ADSPath,8) 'DC=MyDomain,DC=local
strMailDN=SelectMailStore
MakeMail objUser,strMailDN
'///////////////////////////////////////////
'Create Mailbox function
'///////////////////////////////////////////
Sub MakeMail(objUser,strMailDN)
'On Error Resume Next
Err.Clear 'clear any errors that might have occurred previously
'you must have Exchange Administrator Tools installed or run this on the exchange server
'strMailDN="CN=Executive Mail,CN=First Storage Group,CN=InformationStore,CN=ITSERVER1," &_
'"CN=Servers,CN=First Administrative Group,CN=Administrative Groups,CN=HQ," &_
'"CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=COMPANY,DC=LOCAL"
'WScript.Echo "Creating mailbox on " & strMailDN & " for " & objUser.SAMAccountName
'If strFlag="CREATE" then
objUser.CreateMailbox strMailDN
If Err.Number <>0 Then
f.WriteLine Now & " Error creating mailbox for " & objUser.ADSPath & " on " & strMailDN
f.WriteLine Now & " " & Err.Number & " " & Err.Description
Else
objUser.SetInfo
WScript.Echo "Successfully created network folder and mailbox for " & 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")
' WScript.Echo "Name: " & NM
' WScript.Echo "CN: " & CN
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
'display available mailbox stores in groups of 4
If t<>4 And i<>objDict.count-1 Then
t=t+1
Else
MsgBox c,vbOKOnly,"Available Mailbox Stores"
t=1
c=""
End If
Next
iDN=Inputbox("Enter in the number of the mail store you want to use.","Select Mail Store","0")
If iDN = "" Then
WScript.Echo "Nothing entered or you cancelled."
WScript.Quit
End If
If objDict.Exists(Int(iDN)) Then
SelectMailStore=objDict.Item(Int(iDN))
Else
rc=msgBox ("You selected an invalid number. Try again.",vbOKCancel+vbExclamation,"Select Mail Store")
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
Exchange New User from file
Are you getting errors or is the script ending? The script was designed for a single user. You might need to go through and remove the wscript.quit lines.