Exchange New User from file

Anything VBScript-related, including Windows Script Host, WMI, ADSI, and more.
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.
Locked
User avatar
kgocken
Posts: 3
Joined: Tue May 22, 2007 2:19 am

Exchange New User from file

Post by kgocken » Tue May 22, 2007 2:43 am

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!

User avatar
kgocken
Posts: 3
Joined: Tue May 22, 2007 2:19 am

Exchange New User from file

Post by kgocken » Tue May 22, 2007 6:40 am

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 :)

User avatar
jvierra
Posts: 12538
Joined: Tue May 22, 2007 9:57 am
Contact:

Exchange New User from file

Post by jvierra » Tue May 22, 2007 8:08 am

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.



User avatar
kgocken
Posts: 3
Joined: Tue May 22, 2007 2:19 am

Exchange New User from file

Post by kgocken » Tue May 22, 2007 11:42 pm

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

User avatar
jhicks
Posts: 1789
Joined: Sun Jan 21, 2007 11:31 pm

Exchange New User from file

Post by jhicks » Wed May 23, 2007 5:22 am

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.

Locked