' CreateUsers.vbs
' VBScript program to create users according to the information in a
' Microsoft Excel spreadsheet.
'
' ----------------------------------------------------------------------
' 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.
' Version 1.2 - March 18, 2004 - Modify NameTranslate constants.
' Version 2.0 - October 7, 2007 - Specify container for each user object
'                             in spreadsheet. Accept NT names of groups.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

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:\Kayttajat\kayttajat.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 "excell tiedoston avaus ei onnistunut " & 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 = 3

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

    ' 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 "Liittaminen epaonnistui kohteeseen: " & strContainerDN
            Wscript.Echo "Ei voi luoda kayttajaa nimelle: " & 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 "Ei voi luoda kayttajaa orginisaatioyksikkoon: " & 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 "Ei voi luoda kayttajaa nimelle: " & strNTName
            Else
                ' Set password for user.
                objUser.SetPassword strPW
                If (Err.Number <> 0) Then
                    On Error GoTo 0
                    Wscript.Echo "Salasanan antaminen epaonnistui kayttajanimelle " & 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 expired. Must be changed on next logon.
                objUser.pwdLastSet = 0
                ' Save changes.
                On Error Resume Next
                objUser.SetInfo
                If (Err.Number <> 0) Then
                    On Error GoTo 0
                    Wscript.Echo "Vaihdettavaa salasanaa ei onnistuttu laittamaan kayttajanimelle: " _
                        & 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 "Ei voi luoda kotihakemistoa: " & 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 "Virhe annettaessa oikeuksia kotihakemistoon " _
                                & 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 "Ei voi liittaa ryhmaan " & 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
                        blnBound = True
                    End If
                    If (blnBound = True) Then
                        objGroup.Add objUser.AdsPath
                        If (Err.Number <> 0) Then
                            On Error GoTo 0
                            Wscript.Echo "Ei voi lisata kayttajaa " & 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 "VALMIS"

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