VB script to be used in Active Directory

I suspect we'll want two separate scripts to handle this.

This is the first. Output is tab delimited.

Chris

Const GROUP_DN = "CN=Domain Admins,CN=Users,DC=domain,DC=com"
 
Dim objAttributes : Set objAttributes = CreateObject("Scripting.Dictionary")
objAttributes.Add "name", ""
objAttributes.Add "mail", ""
objAttributes.Add "manager", ""
objAttributes.Add "displayName", ""
objAttributes.Add "memberOf", ""
 
Dim strFilter : strFilter = "(&(objectClass=user)(objectCategory=person)(memberOf=" & GROUP_DN & "))"
 
Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
 
Dim strAttribute
Dim strAttributes : strAttributes = "distinguishedName"
For Each strAttribute in objAttributes
  strAttributes = strAttributes & "," & strAttribute
Next
 
Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")
Dim objRecordSet : Set objRecordSet = objConnection.Execute( _
  "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">;" & _
  strFilter & ";" & strAttributes & ";subtree")
Set objRootDSE = Nothing
 
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFSO.OpenTextFile("Users.txt", 2, True, 0)
objFile.WriteLine Replace(strAttributes, ",", vbTab)
 
While Not objRecordSet.EOF
  Dim strLine : strLine = objRecordSet.Fields("distinguishedName").Value
 
  For Each strAttribute in objAttributes
    If IsArray(objRecordSet.Fields(strAttribute).Value) Then
      strLine = strLine & vbTab & Join(objRecordSet.Fields(strAttribute).Value, ";")
    Else
      strLine = strLine & vbTab & objRecordSet.Fields(strAttribute).Value
    End If
  Next
 
  objFile.WriteLine strLine
 
  objRecordSet.MoveNext
WEnd
 
Set objFile = Nothing
Set objFSO = Nothing
 
Set objRecordSet = Nothing
Set objConnection = Nothing

Select allOpen in new window

The second is a bit more difficult.

What kind of format do we have for the import file?

Chris

Hello Chris,
                    Thank you for your quick reply.. The format will be text file.

Regards,
MG

I know, but you must be more specific than that.

VbScript doesn't have a specific "import this file" function, it has to be told everything about the file. What columns am I to expect? What delimiter is being used? If it's comma delimited, do I have to deal with quotes?

Chris

Hello Chris,
                   It should something like,
objLog.WriteLine("User Input File:" & vbTab & USER_LIST)
      objLog.WriteLine("Default Password for users" & vbTab & DEFAULT_PASSWORD)
      objLog.WriteLine("Target AD Location:" & vbTab & strOU)
      objLog.WriteBlankLines(2)
      objLog.WriteLine("samAccountName" & vbTab & "Display Name" & vbTab & "cn")
Will this help? Sorry for not being a good explainer..
Regards,
MG

Perfect, thanks :)

I'll be right back...

Chris

Actually, do you have a format for USER_LIST as well?

Chris

Is this the one you asked for? I am not sure..
Dim strMid
      Dim strItem
      Dim strLine
      Dim strSn
      Dim strGivenName
      Dim strCity
      Dim strCountry
      Dim strSuffix
      Dim strScriptPath
      Dim strLog
      Dim strOU

This is to start us off. I'm still not quite clear on what's to happen with the USER_LIST / attribute list.

However, this creates user accounts (if the username doesn't already exist) and sets a couple of properties then enables the account.

Chris

Const IMPORT_FILE = "C:\Temp\Users.txt"
 
Function ReadFile
  Dim objFile : Set objFile = objFSO.OpenTextFile(IMPORT_FILE, 1, False, 0)
 
  ' Global variables
  strAttributeList = Split(objFile.ReadLine, vbTab)(1)
  strDefaultPassword = Split(objFile.ReadLine, vbTab)(1)
  strTargetOU = Split(objFile.ReadLine, vbTab)(1)
 
  ' Skip the two blank lines
  objFile.SkipLine : objFile.SkipLine
 
  Dim objUsers : Set objUsers = CreateObject("Scripting.Dictionary")
 
  Do While Not objFile.AtEndOfStream
    Dim arrLine : arrLine = Split(objFile.ReadLine, vbTab)
    Dim strSAMAccountName : strSAMAccountName = arrLine(0)
    Dim strDisplayName : strDisplayName = arrLine(1)
    Dim strCN : strCN = arrLine(2)
 
    If Not objUsers.Exists(strSAMAccountName) Then
      objUsers.Add strSAMAccountName, Array(strDisplayName, strCN)
    End If
  Loop
 
  Set ReadFile = objUsers
End Function
 
Function CheckUsers(objUsers)
  Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
  Dim strDomain : strDomain = objNetwork.UserDomain
  Set objNetwork = Nothing
 
  Dim strUsername
  For Each strUsername in objUsers
    Dim strUserDN : strUserDN = GetObjectDN(strUsername, strDomain)
 
    If strUserDN <> "" Then
      objLogFile.WriteLine "User Exists: " & strUsername & " :: " & strUserDN
      objUsers.Remove strUsername
    End If
  Next
 
  Set CheckUsers = objUsers
End Function
 
Function GetObjectDN(strObject, strDomain)
  ' Return Type: String
  '
  ' Returns a Distinguished Name for an Object from it's NT SAM ID.
  ' This will only function for valid object types within an NT Domain structure.
 
  Const ADS_NAME_INITTYPE_GC = 3
  Const ADS_NAME_TYPE_1779 = 1
  Const ADS_NAME_TYPE_NT4 = 3
 
  On Error Resume Next : Err.Clear
  Dim objNameTranslate : Set objNameTranslate = CreateObject("NameTranslate")
 
  objNameTranslate.Init ADS_NAME_INITTYPE_GC, ""
  objNameTranslate.Set ADS_NAME_TYPE_NT4, strDomain & "\" & strObject
  Dim strObjectDN : strObjectDN = objNameTranslate.Get(ADS_NAME_TYPE_1779)
  If Err.Number <> 0 Then  ' Make the DN Blank for a Failed Search
    strObjectDN = ""
  End If
 
  Set objNameTranslate = Nothing
  On Error Goto 0
 
  GetObjectDN = strObjectDN
End Function
 
Sub CreateUsers(objUsers, strTargetOU)
  Dim objOU : Set objOU = GetObject("LDAP://" & strTargetOU)
 
  Dim strUsername
  For Each strUsername in objUsers
    Dim objUser : Set objUser = objOU.Create("user", objUsers(strUsername)(1))
    objUser.Put "sAMAccountname", strUsername
    objUser.Put "displayName", objUsers(strUsername)(0)
    objUser.SetInfo
    objUser.SetPassword strDefaultPassword
 
    objUser.AccountDisabled = False
    objUser.SetInfo
 
    objLogFile.WriteLine "Created User: " & strUsername & " :: " & objUser.Get("distinguishedName")
 
    Set objUser = Nothing
  Next
End Sub
 
 
'
' Main code
'
 
Dim strAttributeList, strDefaultPassword, strTargetOU
 
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objLogFile : Set objLogFile = objFSO.OpenTextFile("LogFile.txt", 2, True, 0)
 
Dim objUsers : Set objUsers = ReadFile
Set objUsers = CheckUsers(objUsers)
 
If objUsers.Count > 0 Then
  CreateUsers objUsers, strTargetOU
End If

Select allOpen in new window

> Is this the one you asked for?

Not quite, I need to see the file it's supposed to be reading (rather than the vbscript parts).

Chris

Hello Chris,
                  I am going to try this one and will get back to you as soon as possible..

Hello Chris,
                    You have been of Great help!! ON the second script, when and where we will be specifying the OU where the users from the users.txt will be imported and get created in that OU.
For example if I want the users in the users.txt to be created in test OU, how will I pass that in this script?
Regards,
MG

Hey :)

This is an example of the file format it read (based on the VbScript code you posted above).

So, the script reads the target OU from the third line of the import file. Then after a two line break it starts reading the users. In this case, the script would skip "dentc" because I exist in my test domain, then create "bob" because he doesn't.

Chris

User Input File:	Not sure at present
Default Password for users:	Password123
Target AD Location:	OU=Test,DC=domain,DC=net
 
 
dentc	Chris Dent	CN=Chris Dent
bob	Bob	CN=Bob

Select allOpen in new window

Hello Chris,
                    Thank you for clarifying my doubts.. I will try this today and will get back to you if I have any questions. Once again you have been a great help!!

Regards,
MG