Добавление пользователей в AD из нескольких Excel-файлов

@Aventer · Регистрация: 31.07.2014

Author24 — интернет-сервис помощи студентам

Доброго времени суток. Недавно появилась потребность заливать в AD тонны юзеров. В итоге, имеется скрипт, который делает это путем извлечения информации из Excel-файла. Далее, собственно, сама проблема. Таких файлов около сотни, и редактировать скрипт, вставляя в него постоянно название следующего файла слишком уж долго и проблематично. Как можно организовать добавление всех файлов экселевских находящихся в определенной папке?

Вот сам скрипт...

Visual Basic

Option Explicit
 
Dim objExcel, strExcelPath, objSheet
Dim strLast, strFirst, strDM, strPW, intRow, intCol
Dim strMN, strEM, strL, strSA
Dim strCO, strPC, strPDON
Dim strGroupDN, objUser, objGroup, objContainer
Dim strCN, strNTName, strContainerDN
Dim strT, strF, strWN, objFSO, objShell
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
Dim strPreviousDN, blnBound
 
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
 
strExcelPath = "C:\MyFolder\NewUsersNew\NewUsers.xlsx"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
 
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
 
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
 
strNetBIOSdomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
 
 
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)
 
intRow = 2
 
strPreviousDN =""
Do While objSheet.Cells(intRow, 6).Value <> ""
    strContainerDN = Trim(objSheet.Cells(intRow, 1).Value)
    strFirst = Trim(objSheet.Cells(intRow, 2).Value)
    strDM = 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)
    strT = Trim(objSheet.Cells(intRow, 9).Value)
    strF = Trim(objSheet.Cells(intRow, 10).Value)
    strMN = Trim(objSheet.Cells(intRow, 11).Value)
    strEM = Trim(objSheet.Cells(intRow, 12).Value)
    strPDON = Trim(objSheet.Cells(intRow, 13).Value)
 
Set objContainer = GetObject("LDAP://" & strContainerDN)
Set objUser = objContainer.Create("user", "cn=" & strCN)
objUser.sAMAccountName = strNTName
objUser.userPrincipalName = strUPN
On Error Resume Next
objUser.SetInfo
objUser.SetPassword "Rkbtyn2011"
objUser.AccountDisabled = False
objUser.SetInfo
If (strFirst <> "") Then
objUser.givenName = strFirst
End If
If (strLast <> "") Then
objUser.sn = strLast
End If
If (strDM <> "") Then
objUser.DisplayName = strDM
End If
If (strT <> "") Then
objUser.Title = strT
End If
If (strF <> "") Then
objUser.Company = strF
End If
If (strMN <> "") Then
objUser.Mobile = strMN
End If
If (strEM <> "") Then
objUser.mail = strEM
End If
If (strPDON <> "") Then
objUser.physicalDeliveryOfficeName = strPDON
End If
On Error Resume Next
objUser.userAccountControl = 66048
objUser.SetInfo
intRow = intRow + 1
objSheet = objSheet+1
Loop
 
 
 
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
 
Wscript.Echo "Done"

@Dmitrii · 31.07.2014, 13:46

Сообщение от Aventer

... Как можно организовать добавление всех файлов экселевских находящихся в определенной папке?..

Пример:

Кликните здесь для просмотра всего текста

Visual Basic

Option Explicit
 
Dim objExcel, strExcelPath, objSheet
Dim strLast, strFirst, strDM, strPW, intRow, intCol
Dim strMN, strEM, strL, strSA
Dim strCO, strPC, strPDON
Dim strGroupDN, objUser, objGroup, objContainer
Dim strCN, strNTName, strContainerDN
Dim strT, strF, strWN, objFSO, objShell
Dim intRunError, strNetBIOSDomain, strDNSDomain
Dim objRootDSE, objTrans, strLogonScript, strUPN
Dim strPreviousDN, blnBound
Dim objItem
 
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
 
strExcelPath = "C:\MyFolder\NewUsersNew"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strExcelPath) Then
    Set objShell = CreateObject("Wscript.Shell")
     
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootDSE.Get("DefaultNamingContext")
     
    Set objTrans = CreateObject("NameTranslate")
    objTrans.Init ADS_NAME_INITTYPE_GC, ""
    objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
    strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
     
    strNetBIOSdomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
     
    Set objExcel = CreateObject("Excel.Application")
 
    On Error Resume Next
    For Each objItem In objFSO.GetFolder(strExcelPath).Files
        If LCase(Right(objItem.Name, 5)) = ".xlsx" Then
            objExcel.Workbooks.Open objItem.Path
            If (Err.Number <> 0) Then
                On Error GoTo 0
                Wscript.Echo "Unable to open spreadsheet " & objItem.Name
                Wscript.Quit
            End If
            On Error GoTo 0
            Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
             
            intRow = 2
             
            strPreviousDN =""
            Do While objSheet.Cells(intRow, 6).Value <> ""
                strContainerDN = Trim(objSheet.Cells(intRow, 1).Value)
                strFirst = Trim(objSheet.Cells(intRow, 2).Value)
                strDM = 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)
                strT = Trim(objSheet.Cells(intRow, 9).Value)
                strF = Trim(objSheet.Cells(intRow, 10).Value)
                strMN = Trim(objSheet.Cells(intRow, 11).Value)
                strEM = Trim(objSheet.Cells(intRow, 12).Value)
                strPDON = Trim(objSheet.Cells(intRow, 13).Value)
             
                Set objContainer = GetObject("LDAP://" & strContainerDN)
                Set objUser = objContainer.Create("user", "cn=" & strCN)
                objUser.sAMAccountName = strNTName
                objUser.userPrincipalName = strUPN
                On Error Resume Next
                objUser.SetInfo
                objUser.SetPassword "Rkbtyn2011"
                objUser.AccountDisabled = False
                objUser.SetInfo
                If (strFirst <> "") Then
                objUser.givenName = strFirst
                End If
                If (strLast <> "") Then
                objUser.sn = strLast
                End If
                If (strDM <> "") Then
                objUser.DisplayName = strDM
                End If
                If (strT <> "") Then
                objUser.Title = strT
                End If
                If (strF <> "") Then
                objUser.Company = strF
                End If
                If (strMN <> "") Then
                objUser.Mobile = strMN
                End If
                If (strEM <> "") Then
                objUser.mail = strEM
                End If
                If (strPDON <> "") Then
                objUser.physicalDeliveryOfficeName = strPDON
                End If
                On Error Resume Next
                objUser.userAccountControl = 66048
                objUser.SetInfo
                intRow = intRow + 1
                objSheet = objSheet+1
            Loop
            objExcel.ActiveWorkbook.Close
        End If
    Next
     
    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
Else
    WScript.Echo "Не найден путь " & strExcelPath
End If
 
Wscript.Echo "Done"

@Aventer · 31.07.2014, 15:10 **[ТС]**

Сообщение от Dmitrii

Пример:
Кликните здесь для просмотра всего текста

Название: Error.jpg
Просмотров: 103

Размер: 15.4 Кб

При запуске добавляет пользователей с первого файла, после чего выдает подобное сообщение. Если точнее, то при попытке обработки второго файла. Независимо от общего количества файлов в папке.

@Dmitrii · 31.07.2014, 16:43

Замените оператор

Visual Basic

1	Wscript.Echo "Unable to open spreadsheet " & objItem.Name

на такой:

Visual Basic

1
2
3

WScript.Echo "File: " & objItem.Name & vbNewLine & _
            "Err code: " & Err.Number & vbNewLine & _
            Err.Description

И покажите полученное сообщение об ошибке.

@Aventer · 31.07.2014, 17:59 **[ТС]**

Сообщение от Dmitrii

И покажите полученное сообщение об ошибке.

Название: Error.jpg
Просмотров: 99

Размер: 11.2 Кб

@Dmitrii · 31.07.2014, 18:07

Aventer, закомментируйте оператор

Visual Basic

1	On Error GoTo 0

стоящий непосредственно перед оператором вывода сообщения об ошибке, и вновь покажите сообщение.

@Aventer · 01.08.2014, 10:38 **[ТС]**

Сообщение от Dmitrii

и вновь покажите сообщение.

Добавление пользователей в AD из нескольких Excel-файлов

@Dmitrii · 01.08.2014, 12:05

Aventer, закомментируйте оставшиеся операторы, начинающиеся с выражения On Error, отредактируйте код сценария так, чтобы его можно было использовать как код макроса, разместите его в VBA-проекте и займитесь отладкой.
Я пока ничем помочь не могу, т.к. у меня нет "под руками" ни домена, ни офисного пакета от MS.

Dragokas · 01.08.2014, 15:43

Aventer, на какой строке возникает ошибка?
Это будет указано в ошибке, если сделать то, что Dmitrii сказал.

@Aventer · 01.08.2014, 18:11 **[ТС]**

Сообщение от Dmitrii

отредактируйте код сценария так, чтобы его можно было использовать как код макроса, разместите его в VBA-проекте и займитесь отладкой.

Учитывая мои познания в данном вопросе - вышесказанное прозвучало для меня на китайском

@Aventer 0 / 0 / 0 Регистрация: 31.07.2014 Сообщений: 6
	31.07.2014, 15:10 [ТС]	3
	Сообщение от Dmitrii Пример: Кликните здесь для просмотра всего текста При запуске добавляет пользователей с первого файла, после чего выдает подобное сообщение. Если точнее, то при попытке обработки второго файла. Независимо от общего количества файлов в папке. 0

@Aventer 0 / 0 / 0 Регистрация: 31.07.2014 Сообщений: 6
	31.07.2014, 17:59 [ТС]	5
	Сообщение от Dmitrii И покажите полученное сообщение об ошибке. 0

@Aventer 0 / 0 / 0 Регистрация: 31.07.2014 Сообщений: 6
	01.08.2014, 10:38 [ТС]	7
	Сообщение от Dmitrii и вновь покажите сообщение. 0

@Dmitrii 2618 / 548 / 109 Регистрация: 21.03.2012 Сообщений: 1,051
	01.08.2014, 12:05	8
	Aventer, закомментируйте оставшиеся операторы, начинающиеся с выражения On Error, отредактируйте код сценария так, чтобы его можно было использовать как код макроса, разместите его в VBA-проекте и займитесь отладкой. Я пока ничем помочь не могу, т.к. у меня нет "под руками" ни домена, ни офисного пакета от MS. 0

Dragokas 17996 / 7697 / 892 Регистрация: 25.12.2011 Сообщений: 11,470 Записей в блоге: 16
	01.08.2014, 15:43	9
	Aventer, на какой строке возникает ошибка? Это будет указано в ошибке, если сделать то, что Dmitrii сказал. 0

@Aventer 0 / 0 / 0 Регистрация: 31.07.2014 Сообщений: 6
	01.08.2014, 18:11 [ТС]	10
	Сообщение от Dmitrii отредактируйте код сценария так, чтобы его можно было использовать как код макроса, разместите его в VBA-проекте и займитесь отладкой. Учитывая мои познания в данном вопросе - вышесказанное прозвучало для меня на китайском 0

Опции темы