Page 1 of 1

Exchange New User from file

Posted: Tue May 22, 2007 2:43 am
by kgocken
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

Posted: Tue May 22, 2007 6:40 am
by kgocken
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 :)

Exchange New User from file

Posted: Tue May 22, 2007 8:08 am
by jvierra
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

Posted: Tue May 22, 2007 11:42 pm
by kgocken
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....

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

Posted: Wed May 23, 2007 5:22 am
by jhicks
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.