RE: export user accounts from NT 4.0 domain

From: Eng (eugeniotalarico_at__REMOVE_THIS_vodafone.it)
Date: 02/17/05 

Date: Thu, 17 Feb 2005 01:01:06 -0800

For create user.
The original script was from Richard L. Mueller http://www.rlmueller.net/
With the one posted here you can set also other parameters.

ATTENTION THE SCRIPT MUST BE RUNNED FROM A COMPUTER WHERE EXCEL IS
INSTALLED!!!!
USE FOR EXAMPLE A MEMBER SERVER WHERE YOU PREVIOUSLY HAVE INSTALLED IT.

TO RUN THE SCRIPT:
CSCRIPT NAME.VBS IMPORTFILE.XLS >> OUTPUT.TXT

With Redirect to OUTPUT.TXT YOU CAN SEE IF THERE'S SOME ERROR
TO ANALIZE IT AFTER.

OTHER PARAMETER INSIDE THE VBS

'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'**** INTO STRVARIABL LINE PUT THE PATH WHERE THE GROUPS YOU WANT TO ADD TO
USER
'**** IS CONTAINED (EX: strVariabl = "OU=Sales,OU=External_Sales")
'**** INTO strContainerDN Specify DN of container where users will be created.
'**** INTO strExcelPath Specify WHERE THE XLS INPUT FILE IS CONTAINED.
'*********************************************************************************
'*********************************************************************************
strVariabl = "OU=groups"
strExcelPath = "c:\import.xls"
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************

If you have more than 1 groups where you want to add the user, THE N groups
must be placed ALL into the same container, otherwise you have to use another
script to add the user to groups that is located in another place different
from the strVariabl. The same is for the location where ALL the user
will be created.
-------------------------------------------
STRUCTURE OF XLS FILE

VBScript program to create new Active Directory user accounts in bulk
from the information in a Microsoft Excel spread***.
The program creates the user object, sets the initial password, enables the
account,
assigns values to several attributes, and SETS THE PASSWORD EXPIRED SO THE
USER MUST
CHANGE THE PASSWORD THE FIRST TIME THEY LOGON. The program can also make
the new user
a member of one or more groups. The Active Directory container where the
user objects
are created is hard coded in the program. The name and path of the
spread*** with
the information on the new users is also hard coded.

Creating users from the information in a spread*** is very powerful.
You can use formulas to assign values to many of the cells according to values
in other cells. For example, the values for the cn and sAMAccountName
attributes
can be functions of the first and last names assigned to the user.
The homeFolder attribute can also be calculated from the values in other
cells.
It's easy to copy values and formulas to other rows in the spread***.

THE FIRST ROW OF THE INPUT SPREAD*** IS SKIPPED - it is assumed to have
column headings. One user is created for each subsequent row in the
spread***,
until the first blank row is encountered (actually, the first blank entry in
column F,
for cn). The columns of the spread*** should have values for the following
attributes:

Column Attribute Description
A OU CONTEINED --> PUT the Ou where the user will be created.
B givenName --> First name
C initials --> Middle Initial
D sn --> Last name
E DisplayNAME --> DisplayNAME
F Description --> Description
G --> Password you want to set
H --> Request to change password next logon
I CN --> Common name
J sAMAccountName --> NT logon name (pre-Windows 2000)
K userPrincipalName --> User logon name (email style)
L homeDirectory --> Home folder UNC path
M homeDrive --> Drive letter to map home folder
N scriptPath --> Logon script
O msNPAllowDialIn --> Allow DIAL IN
P DN of group(s)

Any of the columns can be blank, except for cn which is required to create
users.
The sAMAccountName attribute is also mandatory, but the program defaults to
assign
the same value to cn and sAMAccountName if no value is provided for the later.
Column "O" can have the Distinguished Name (DN) of a group.
The new user will be made a member of this group. More groups can be
designated
in subsequent columns. The program will add the user to all groups
designated from
column "K" until the first blank cell in the row is encountered.
All users are automatically members of the group "Domain Users",
which is the "primary" group.

When the program assigns the homeDirectory attribute, it attempts to create
the folder if it does not already exist. Then the program grants the new
user all
rights to this folder.

----------------------
----------------------

' VBScript program to create users according to the information in a
' Microsoft Excel spread***.
' ----------------------------------------------------------------------
' Copyright (c) 2003 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - September 8, 2003
' Version 1.1 - January 25, 2004 - Modify error trapping.
'
' Modify by Eugenio Talarico 15/03/2004
'** mailto: eugeniotalarico@REMOVE_me_vodafone.it
'** Added other parameters such as the OU where the Object will be created,
'** the Dial-In permision, the chg pwd and other...

Option Explicit

'** Declare all VAriable will used into the XLS FILE and something else

Dim objExcel, strExcelPath, obj***
Dim strLast, strFirst, strMiddle, strPW, intRow, intCol
Dim strGroupDN, objUser, objGroup, objContainer, strVariabl, strFissa,
strpwdchg, strDisName
Dim strCN, strNTName, strContainerDN, strDialIN, strDescription, strContUno
Dim strOffice,strTelNum,strMail
Dim strHomeFolder, strHomeDrive, objFSO, objShell
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_DOMAIN = 1
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1179 = 1

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

'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
'**** INTO STRVARIABL LINE PUT THE PATH WHERE THE GROUPS
'**** IS CONTAINED (EX: strVariabl = "OU=Sales,OU=External_Sales")
'**** INTO strContainerDN Specify DN of container where users will be created.
'**** INTO strExcelPath Specify WHERE THE XLS INPUT FILE IS CONTAINED.
'**** INTO strpwdchg put 0 USER MUST CHANGE PWD or -1 Deselect USER MUST
CHANGE PWD.
'*********************************************************************************
'*********************************************************************************
strVariabl = "OU=groups"
strExcelPath = "c:\cuser\import.xls"
'*********************************************************************************
'*********************************************************************************
'*********************************************************************************
strContainerDN = ""
strFissa = "," & strVariabl & "," & objRootDSE.Get("defaultNamingContext")

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

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

'** Open spread***.
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 spread*** " & strExcelPath
  Wscript.Quit
End If
On Error GoTo 0
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

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

'**************************************************************
'**************************************************************
'**************************************************************
'** SET THE COLUMNS NUMBER FOR INPUT FROM XLS
'**************************************************************
'**************************************************************
'**************************************************************
Dim intOU,intFName,intMName,intLName,intDisName,intOffice,intTel
dim intemil,intpwd,intpwdchg,intCname,intntpre,inthfolder,intDescr
dim intuln,inthfolletter,intlgscript,intDialIN

IntOU = 2 '**OU where create Obj
intFname = 3 '**First Name
IntMname = 4 '**Middle Name
IntLname = 5 '**Last Name
intDisName = 6 '**Display Name
intDescr = 7 '**Description
intOffice = 8 '**Office Location
intTel = 9 '**Telefone Numeber
intemil= 10 '**User email
intpwd = 11 '**User Password
intpwdchg =12 '**user Pwd Chg request
intCname = 13 '* User Common Name
intntpre =14 '* NT pre-w2k Logon Name
intuln = 15 '* User Logon Name
inthfolder = 16 '* Home Folder
inthfolletter =17 '*Home Folder Map Letter
intlgscript = 18 '* Logon Script
intDialIN = 19 '*Allow DIalIN

'*** ATTENTION THE DIALIN MUST ALWAYS TO BE THE LAST INTO THE
'*** XLS FILE ... ALWAYS!!!
'**************************************************************
'**************************************************************
'**************************************************************
'** END SET THE COLUMNS NUMBER FOR INPUT FROM XLS
'**************************************************************
'**************************************************************
'**************************************************************

' Read each row of spread*** until a blank value
' encountered in column intCname (the column for cn).
' For each row, create user and set attribute values.
Do While obj***.Cells(intRow, intCname).Value <> ""
  '** Read values from spread*** for this user.
  '** Bind to container where users to be created.
  intCol = intDialIN + 1
  strContainerDN=Trim(obj***.Cells(intRow, IntOU).Value)
  strContUno = strContainerDN & "," & strDNSDomain
  strContainerDN = strContUno
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.Quit
End If
On Error GoTo 0
  strFirst = Trim(obj***.Cells(intRow, intFname).Value)
  strMiddle = Trim(obj***.Cells(intRow, IntMname).Value)
  strLast = Trim(obj***.Cells(intRow, IntLname).Value)
  strDisName = Trim(obj***.Cells(intRow, intDisName).Value)
  strDescription = Trim(obj***.Cells(intRow, intDescr).Value)
  strPW = Trim(obj***.Cells(intRow, intpwd).Value)
  strpwdchg = Trim(obj***.Cells(intRow, intpwdchg).Value)
  strCN = Trim(obj***.Cells(intRow, intCname).Value)
  strNTName = Trim(obj***.Cells(intRow, intntpre).Value)
  strUPN = Trim(obj***.Cells(intRow, intuln).Value)
  strHomeFolder = Trim(obj***.Cells(intRow, inthfolder).Value)
  strHomeDrive = Trim(obj***.Cells(intRow, inthfolletter).Value)
  strLogonScript = Trim(obj***.Cells(intRow, intlgscript).Value)
  strDialIN = Trim(obj***.Cells(intRow, intDialIN).Value)
  strOffice = Trim(obj***.Cells(intRow, intOffice).Value)
  strTelNum = Trim(obj***.Cells(intRow, intTel).Value)
  strMail = Trim(obj***.Cells(intRow, intemil).Value)
  '**********************
  '** Create user object.
  On Error Resume Next
  Set objUser = objContainer.Create("user", "cn=" & strCN)
  '***************************************************************************
  '** Creating user and after assign it's parameters like name pwd and so on..
  '***************************************************************************
  '***************************************************************************
  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.
      Wscript.Echo "User: " & strCN & " Succesfully Created!"
      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
      '***********************
      '** USER IS CREATED NOW WE PUT THE ATTRIBUTE TAKED FROM THE COLUM OF
THE XLS
      '** The order of the IF is NOT important because the value of the
object are
      '** already into the strASSIGNED. IF the value of the xls cell is blank
      '** the parameter will not be set.
      '***********************
      If strOffice <> "" Then
        objUser.PhysicalDeliveryOfficeName = strOffice
      End If
      If strTelNum <> "" Then
        objUser.TelephoneNumber= strTelNum
      End If
      If strMail <> "" Then
        objUser.Mail = strMail
      End If
      If strFirst <> "" Then
        objUser.givenName = strFirst
      End If
      ' Assign values to remaining attributes.
      If strMiddle <> "" Then
        objUser.initials = strMiddle
      End If
      If strDisName <> "" Then
        objUser.Displayname = strDisName
      End If
      If strDescription <> "" Then
        objUser.Description = strDescription
      End If
      If strLast <> "" Then
        objUser.sn = strLast
      End If
      If strUPN <> "" Then
        objUser.userPrincipalName = strUPN
      End If
      If strDialIN <> "" Then
        If (strDialIN = "True") or (strDialIN = "TRUE") or (strDialIN = "true")Then
            objUser.MsNPAllowDialin = True
        Else
            objUser.MsNPAllowDialin = False
        End If
      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 expired. Must be changed on next logon.
      objUser.pwdLastSet = strpwdchg
      '** 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 Not objFSO.FolderExists(strHomeFolder) 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) 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

      '************************************
      '** PUT the user created into GROUPS
      '** Group DN's start in column intDialIN + 1.
      Do While obj***.Cells(intRow, intCol).Value <> ""
        strGroupDN = Trim(obj***.Cells(intRow, intCol).Value)
        On Error Resume Next
        '************************************************
        '** Move LDAP pointer where GROUPS is contained!!
        '************************************************
        Set objGroup = GetObject("LDAP://cn=" & strGroupDN & strFissa)

        If Err.Number <> 0 Then
          On Error GoTo 0
          Wscript.Echo "Unable to bind to group " & strGroupDN
          wscript.echo objuser.adspath
        Else
          objGroup.Add objUser.AdsPath
          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
  ' Increment to next user.
  intRow = intRow + 1
Loop

Wscript.Echo "Work Done"

' Clean up.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
Set objUser = Nothing
Set objGroup = Nothing
Set objContainer = Nothing
Set obj*** = Nothing
Set objExcel = Nothing
Set objFSO = Nothing
Set objShell = Nothing
Set objTrans = Nothing
Set objRootDSE = Nothing