Creating user accounts with VBScript in Active Directory

Hello,

I am total newbie when it comes to VBScript, but I've been piecing some things together little by little.  Anyway, what I'd like to do is create a VBScript that utilizes an Excel document, and adds a batch of users to a specific Active Directory OU.

I've been able to do 90% of it, but now I'm stuck with some minor details.  I'm attaching my code below in hopes that someone can point me in the right direction.

What I'd like the script to do is: 1.) assign the users to a specific group(s)  2.) Set it so that their password never expires and 3.) Set it so that they cannot change their passwords.  Also, if you can spot any redundancy or anything else I've done wrong, that would be great too!  Thanks in advance!

Here's my code, hopefully it's an easy tweak:
-------------------------------------
Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strUPN, strFirst, strLast, strPWD, strDescription

strOU = "OU=Accounting ,"
strSheet = "D:\scripts\import.xls"

' Bind to Active Directory, Users container.
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 3

' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet
Do Until objExcel.Cells(intRow,1).Value = ""
   strUPN = Trim(objExcel.Cells(intRow, 1).Value)
   strCN = Trim(objExcel.Cells(intRow, 2).Value)
   strFirst = Trim(objExcel.Cells(intRow, 3).Value)
   strLast = Trim(objExcel.Cells(intRow, 4).Value)
   strPWD = Trim(objExcel.Cells(intRow, 5).Value)
   strDescription = Trim(objExcel.Cells(intRow, 6).value)
   strOU = Trim(objExcel.Cells(intRow, 7).value)

   ' Build the actual User from data in strSheet.
   Set objUser = objContainer.Create("User", "cn=" & strCN)
   objUser.userPrincipalName = strUPN
   objUser.givenName = strFirst
   objUser.sn = strLast
   objUser.SetInfo
   objuser.description = strDescription
   

   ' Separate section to enable account with its password
   objUser.userAccountControl = 512
   objUser.pwdLastSet = 0
   objUser.SetPassword strPWD
   objUser.SetInfo

intRow = intRow + 1
Loop
objExcel.Quit

WScript.Quit

' End of Sample UserSpreadsheet VBScript.
esckeyrwmAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

esckeyrwmAuthor Commented:
Hi again,

Since I didn't get any takers - I'm upping the point value.  Any help would be greatly appreciated!

Thanks!
Chris DentPowerShell DeveloperCommented:

Hi,

Assigning to Groups is quite straightforward.

You need to create an LDAP connection to the group. i.e.:

Set objGroup = GetObject("LDAP://CN=<Group Name>,OU=<Group OU>," &_
            objRootLDAP.Get("defaultNamingContext"))

Then with the Group you can add members:

objGroup.Add objUser.ADSPath

I'm heading off for lunch but I'll post back how to do the other two bits afterwards. You need to modify the userAccountControl attribute a little more.

Chris
Chris DentPowerShell DeveloperCommented:

And here's the other two attributes. It's tricky to detect whether Password Cannot Change is actually set so this cheats a little and sets the attribute regardless. You'll need to add the Constants the plug the If statements in.

Const ADS_UF_ACCOUNTDISABLE = &H2
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000

Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6
Const ADS_ACEFLAG_OBJECT_TYPE_PRESENT = &H1
Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-00aa0040529b}"
Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100

intUAC = objUser.Get("userAccountControl")
If ADS_UF_ACCOUNTDISABLE AND intUAC Then          
      objUser.Put "userAccountControl", intUAC XOr ADS_UF_ACCOUNTDISABLE
      objUser.SetInfo
End If

intUAC = objUser.Get("userAccountControl")
If ADS_UF_DONT_EXPIRE_PASSWD And intUAC Then
      ' Password is already set to Never Expire
Else
      WScript.Echo "Setting Password Never Expires"
      objUser.Put "userAccountControl", intUAC XOr ADS_UF_DONT_EXPIRE_PASSWD
      objUser.SetInfo
End If

Set objSD = objUser.Get("ntSecurityDescriptor")
Set objDACL = objSD.DiscretionaryAcl

arrTrustees = array("NT AUTHORITY\SELF", "EVERYONE")

For Each strTrustee in arrTrustees
      Set objACE = CreateObject("AccessControlEntry")
      objACE.Trustee = strTrustee
      objACE.AceFlags = 0
      objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
      objACE.Flags = ADS_ACEFLAG_OBJECT_TYPE_PRESENT
      objACE.ObjectType = CHANGE_PASSWORD_GUID
      objACE.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
      objDACL.AddAce objACE
Next
objSD.DiscretionaryAcl = objDACL
objUser.Put "nTSecurityDescriptor", objSD
objUser.SetInfo


Chris
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Chris DentPowerShell DeveloperCommented:

Should have noted that you can't use:

objUser.userAccountControl = 512

With the code above, it explicitly sets the controls rather than basing it on what's already there.

Chris
esckeyrwmAuthor Commented:
Hi Chris,

Thanks for answering this.  Because I'm still learning, would you mind posting what my script should look like with your code inserted into it?  I guess I don't want to get the syntax wrong at any point.  I'll award you all the points for this answer.

Thanks again!
Chris DentPowerShell DeveloperCommented:

Most of that request is easy enough and the modified code is below. Adding the user to a group is still a bit ambiguous, we don't have a DN for the group so that will need completing, the code is in a place where it will work.

I hope I remembered to declare all the variables...

Chris


Option Explicit

Const ADS_UF_ACCOUNTDISABLE = &H2
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000

Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6
Const ADS_ACEFLAG_OBJECT_TYPE_PRESENT = &H1
Const CHANGE_PASSWORD_GUID = "{ab721a53-1e2f-11d0-9819-00aa0040529b}"
Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100

Dim objRootLDAP, objContainer, objUser, objShell
Dim objExcel, objSpread, objSD, objDACL, objACE
Dim strUser, strOU, strSheet, strTrustee
Dim strCN, strUPN, strFirst, strLast, strPWD, strDescription
Dim arrTrustee
Dim intRow, intUAC

strOU = "OU=Accounting ,"
strSheet = "D:\scripts\import.xls"
      
' Bind to Active Directory, Users container.
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 3

' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet

Do Until objExcel.Cells(intRow,1).Value = ""

      strUPN = Trim(objExcel.Cells(intRow, 1).Value)
      strCN = Trim(objExcel.Cells(intRow, 2).Value)
      strFirst = Trim(objExcel.Cells(intRow, 3).Value)
      strLast = Trim(objExcel.Cells(intRow, 4).Value)
      strPWD = Trim(objExcel.Cells(intRow, 5).Value)
      strDescription = Trim(objExcel.Cells(intRow, 6).value)
      strOU = Trim(objExcel.Cells(intRow, 7).value)

      ' Build the actual User from data in strSheet.

      Set objUser = objContainer.Create("User", "cn=" & strCN)
      objUser.userPrincipalName = strUPN
      objUser.givenName = strFirst
      objUser.sn = strLast
      objUser.SetInfo
      objuser.description = strDescription
      
      ' Separate section to enable account with its password

      ' Enable User Account if Disabled

      intUAC = objUser.Get("userAccountControl")
      If ADS_UF_ACCOUNTDISABLE AND intUAC Then                   
            objUser.Put "userAccountControl", intUAC XOr ADS_UF_ACCOUNTDISABLE
            objUser.SetInfo
      End If

      ' Set the Password to Never Expire

      intUAC = objUser.Get("userAccountControl")
      If ADS_UF_DONT_EXPIRE_PASSWD And intUAC Then
            ' Password is already set to Never Expire
      Else
            objUser.Put "userAccountControl", intUAC XOr ADS_UF_DONT_EXPIRE_PASSWD
            objUser.SetInfo
      End If

      ' Set User Cannot Change Password

      Set objSD = objUser.Get("ntSecurityDescriptor")
      Set objDACL = objSD.DiscretionaryAcl

      arrTrustees = array("NT AUTHORITY\SELF", "EVERYONE")

      For Each strTrustee in arrTrustees
            Set objACE = CreateObject("AccessControlEntry")
            objACE.Trustee = strTrustee
            objACE.AceFlags = 0
            objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT
            objACE.Flags = ADS_ACEFLAG_OBJECT_TYPE_PRESENT
            objACE.ObjectType = CHANGE_PASSWORD_GUID
            objACE.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS
            objDACL.AddAce objACE
      Next
      objSD.DiscretionaryAcl = objDACL
      objUser.Put "nTSecurityDescriptor", objSD
      objUser.SetInfo

      objUser.pwdLastSet = 0
      objUser.SetPassword strPWD
      objUser.SetInfo

      ' Add User to a Group
      
      Set objGroup = GetObject("LDAP://CN=<Group Name>,OU=<Group OU>," &_
          objRootLDAP.Get("defaultNamingContext"))
      objGroup.Add objUser.ADSPath

      intRow = intRow + 1
Loop
objExcel.Quit

WScript.Quit

' End of Sample UserSpreadsheet VBScript.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
esckeyrwmAuthor Commented:
Thank you!!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.