Add Users to Groups and OU's in AD from Excel using VB Scripy

[Munky5]

I have a script that I am trying to get to work that will read a list of users and what groups and OU they belong to from an excel spreedsheet. I either get it to run with no errors and it does everything correct except it only puts them in Domain User Group not the ones I have listed, or I get it to list everyone in the correct group an OU, but errors and only does the first 2 rows on the excel spreedsheet. Anyone help me with this? Here is what Im using that runs without errors but only puts them as Domain Users.

Option Explicit

Dim objExcel, strExcelPath, objSheet
Dim strLast, strFirst, strMiddle, strPW, intRow, intCol
Dim strGroupDN, objUser, objGroup, objContainer
Dim strCN, strNTName, strContainerDN
Dim strHomeFolder, strHomeDrive, objFSO, objShell
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
Dim strPreviousDN, blnBound

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

' Specify spreadsheet.
strExcelPath = "D:\Software\UserGroupBackup\UsersTest.xls"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")

' Use the NameTranslate object to find the NetBIOS domain name
' from the DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSdomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)

' Open spreadsheet.
Set objExcel = CreateObject("Excel.Application")

On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to open spreadsheet " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Start with row 2 of spreadsheet.
' Assume first row has column headings.
intRow = 2

' Read each row of spreadsheet until a blank value
' encountered in column 6 (the column for cn).
' For each row, create user and set attribute values.
strPreviousDN = ""
Do While objSheet.Cells(intRow, 6).Value <> ""
' Read values from spreadsheet for this user.
strContainerDN = Trim(objSheet.Cells(intRow, 1).Value)
strFirst = Trim(objSheet.Cells(intRow, 2).Value)
strMiddle = Trim(objSheet.Cells(intRow, 3).Value)
strLast = Trim(objSheet.Cells(intRow, 4).Value)
strPW = Trim(objSheet.Cells(intRow, 5).Value)
strCN = Trim(objSheet.Cells(intRow, 6).Value)
strNTName = Trim(objSheet.Cells(intRow, 7).Value)
strUPN = Trim(objSheet.Cells(intRow, 8).Value)
strHomeFolder = Trim(objSheet.Cells(intRow, 9).Value)
strHomeDrive = Trim(objSheet.Cells(intRow, 10).Value)
strLogonScript = Trim(objSheet.Cells(intRow, 11).Value)
strGroupDN = Trim(objSheet.Cells(intRow, 12).Value)

' If this container is different from the previous, bind to
' the container the user object will be created in.
If (strContainerDN <> strPreviousDN) Then
On Error Resume Next
Set objContainer = GetObject("LDAP://" & strContainerDN)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to bind to container: " & strContainerDN
Wscript.Echo "Unable to create user with NT name: " & strNTName
' Flag that container not bound.
strPreviousDN = ""
Else
On Error GoTo 0
strPreviousDN = strContainerDN
End If
End If
' Proceed if parent container bound.
If (strPreviousDN <> "") Then
' Create user object.
On Error Resume Next
Set objUser = objContainer.Create("user", "cn=" & strCN)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to create user with cn: " & strCN
Else
On Error GoTo 0
' Assign mandatory attributes and save user object.
If (strNTName = "") Then
strNTName = strCN
End If
objUser.sAMAccountName = strNTName
On Error Resume Next
objUser.SetInfo
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to create user with NT name: " & strNTName
Else
' Set password for user.
objUser.SetPassword strPW
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to set password for user " & strNTName
End If
On Error GoTo 0
' Enable the user account.
objUser.AccountDisabled = False
If (strFirst <> "") Then
objUser.givenName = strFirst
End If
' Assign values to remaining attributes.
If (strMiddle <> "") Then
objUser.initials = strMiddle
End If
If (strLast <> "") Then
objUser.sn = strLast
End If
If (strUPN <> "") Then
objUser.userPrincipalName = strUPN
End If
If (strHomeDrive <> "") Then
objUser.homeDrive = strHomeDrive
End If
If (strHomeFolder <> "") Then
objUser.homeDirectory = strHomeFolder
End If
If (strLogonScript <> "") Then
objUser.scriptPath = strLogonScript
End If
' Set password never expire.
objUser.pwdLastSet = -1
' Save changes.
On Error Resume Next
objUser.SetInfo
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to set attributes for user with NT name: " _
& strNTName
End If
On Error GoTo 0
' Create home folder.
If (strHomeFolder <> "") Then
If (objFSO.FolderExists(strHomeFolder) = False) Then
On Error Resume Next
objFSO.CreateFolder strHomeFolder
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to create home folder: " & strHomeFolder
End If
On Error GoTo 0
End If
If (objFSO.FolderExists(strHomeFolder) = True) Then
' Assign user permission to home folder.
intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " _
& strHomeFolder & " /T /E /C /G " & strNetBIOSDomain _
& "\" & strNTName & ":F", 2, True)
If (intRunError <> 0) Then
Wscript.Echo "Error assigning permissions for user " _
& strNTName & " to home folder " & strHomeFolder
End If
End If
End If
' Group DN's start in column 12.
intCol = 12
Do While objSheet.Cells(intRow, intCol).Value <> ""
strGroupDN = Trim(objSheet.Cells(intRow, intCol).Value)
' Attempt to bind to group object DN.
blnBound = False
On Error Resume Next
Set objGroup = GetObject("LDAP://" & strGroupDN)
If (Err.Number <> 0) Then
On Error GoTo 0
' Try again converting NT Name to DN.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain _
& "\" & strGroupDN
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to bind to group " & strGroupDN
Else
On Error GoTo 0
strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
Set objGroup = GetObject("LDAP://" & strGroupDN)
blnBound = True
End If

Else
On Error GoTo 0

If (blnBound = True) Then
objGroup.Add(objUser.ADsPath)
End If

If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Unable to add user " & strNTName _
& " to group " & strGroupDN
End If
End If
On Error GoTo 0
' Increment to next group DN.
intCol = intCol + 1
Loop
End If
End If
End If
' Increment to next user.
intRow = intRow + 1
Loop

Wscript.Echo "You Have Completed The User and Group Installation Successfully!"

' Clean up.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit