Возникла необходимость вытянуть данные по пользователям из Active Directory (AD) в таблицу Excel в формате, понятном не только системному администратору :) . Т.к. пользователи приходят/увольняются, то вручную каждый раз переделывать таблицу размером в 2 листа формата А3 мелким шрифтом как-то не по админски, поэтому, будем автоматизировать процесс создания таблицы при помощи VBScript - предоставим серверу выполнение этой задачи, пока мы будем заниматься более полезными вещами.
Исходные данные:
1) Имя домена: domen.local
2) Существует несколько филиалов территориально расположенных вдали друг от друга, каждый филиал сидит в своем OU и имеет свой набор групп пользователей. Все группы пользователей филиалов являются членами одной общей группы филиала. В свою очередь каждая общая группа филиала является членом общей группы предприятия.
Условная схема групп домена:
Задача:
Отобразить в определенной таблице Excel всех сотрудников (пользователей) предприятия с данными о принадлежности к определенным группам безопасности.Соответственно по каждому пользователю отобразить дополнительные данные (почтовый ящик и т.д.). В пределах групп будем сортировать пользователей в алфавитном порядке. Уволившихся сотрудников отмечаем красным цветом.
Содержимое скрипта надо сохранить в виде обычного текстового файла (NOTEPAD) и изменить расширение на .vbs
Например:
examle.vbs
Const ADS_SCOPE_SUBTREE = 2
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
'On Error Resume Next ' Не спотыкаться на ошибках
' Обьявляем массивы
Dim XLAp
Dim XLWb
Dim XLWs
Dim objADObject, strGroup, objGroupList
' Запускаем EXCEL
Set XLAp = CreateObject("Excel.Application")
XLAp.Visible = True
lst = 1
Set XLWb = XLAp.Workbooks.Add
Set XLWs = XLWb.Worksheets(lst)
XLWs.Activate
' Настройки листа EXCEL
XLAp.ActiveSheet.PageSetup.Zoom = 60
XLAp.ActiveSheet.PageSetup.PaperSize = 8
XLAp.ActiveSheet.PageSetup.CenterHorizontally = True
XLAp.ActiveSheet.PageSetup.LeftMargin = XLAp.Application.InchesToPoints(0.25)
XLAp.ActiveSheet.PageSetup.RightMargin = XLAp.Application.InchesToPoints(0.25)
XLAp.ActiveSheet.PageSetup.TopMargin = XLAp.Application.InchesToPoints(0.75)
XLAp.ActiveSheet.PageSetup.BottomMargin = XLAp.Application.InchesToPoints(0.75)
XLAp.ActiveSheet.PageSetup.HeaderMargin = XLAp.Application.InchesToPoints(0.3)
XLAp.ActiveSheet.PageSetup.FooterMargin = XLAp.Application.InchesToPoints(0.3)
' Выставляем длинну колонок
XLAp.Columns("A:A").ColumnWidth = 0.58
XLAp.Columns("B:C").ColumnWidth = 2.71
XLAp.Columns("D:D").ColumnWidth = 21.86
XLAp.Columns("E:E").ColumnWidth = 29.43
XLAp.Columns("F:F").ColumnWidth = 4.43
XLAp.Columns("G:G").ColumnWidth = 36.86
XLAp.Columns("H:T").ColumnWidth = 5.00
XLAp.Columns("U:U").ColumnWidth = 42.14
XLAp.Columns("V:V").ColumnWidth = 2.43
' Выставляем параметры столбцов
XLAp.Range("D:D").Select
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
XLAp.Selection.Font.Bold = True
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Range("H:T").Select
XLAp.Selection.Font.Bold = True
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
' Выставляем высоту ячеек
XLAp.Rows("1:1").RowHeight = 5.25
XLAp.Rows("2:2").RowHeight = 12.75
XLAp.Rows("3:3").RowHeight = 18.75
XLAp.Rows("7:7").RowHeight = 15.75
XLAp.Rows("4:6").RowHeight = 12.75
XLAp.Rows("10:10").RowHeight = 132.75
' Задаем шрифт и высоту строк ячеек
XLAp.Rows("13:255").Select
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Selection.RowHeight = 10.00
' Обьединяем ячейки
XLAp.Range("B7:V7").Merge
XLAp.Range("B10:C10").Merge
XLAp.Range("F9:F10").Merge
XLAp.Range("B9:C10").Merge
XLAp.Range("D9:D10").Merge
XLAp.Range("E9:E10").Merge
XLAp.Range("H9:K9").Merge
XLAp.Range("L9:P9").Merge
XLAp.Range("Q9:Q10").Merge
XLAp.Range("R9:R10").Merge
XLAp.Range("S9:S10").Merge
XLAp.Range("T9:T10").Merge
XLAp.Range("U9:V10").Merge
' Оформляем шапку таблицы
XLAp.Range("U2:U6").Select
With XLAp.Selection.Font
.Name = "Tahoma"
.Size = 10
End With
XLAp.Range("U2:U2").Select
XLAp.ActiveCell.FormulaR1C1 = "УТВЕРЖДАЮ"
XLAp.Range("U3:U3").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
XLAp.Range("U4:U4").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
XLAp.Range("U5:U5").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
XLAp.Range("U6:U6").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
' Красим, заполняем шапку таблицы
XLAp.Range("B7:V7").Select
With XLAp.Selection.Font
.Bold = True
.Name = "Calibri"
.Size = 16
End With
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
XLAp.ActiveCell.FormulaR1C1 = "Схема распределения прав пользователей в группах домена DOMEN.LOCAL"
XLAp.Range("B9:V10").Select
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
With XLAp.Selection.Font
.Bold = True
.Name = "Tahoma"
.Size = 8
End With
With XLAp.Selection.Borders
.LineStyle = 1
.Weight = -4138
End With
With XLAp.Selection.Interior
.ThemeColor = 1
.TintAndShade = -0.149998474074526
End With
XLAp.Range("B10:C10").Select
XLAp.ActiveCell.FormulaR1C1 = "№"
XLAp.Range("D9:D10").Select
XLAp.ActiveCell.FormulaR1C1 = "Название группы"
XLAp.Range("E9:E10").Select
XLAp.Selection.Interior.Color = 14922893
XLAp.ActiveCell.FormulaR1C1 = "Название подгруппы (Англ.)"
XLAp.Range("F9:F10").Select
XLAp.Selection.Orientation = -90
XLAp.Selection.Interior.Color = 14922893
XLAp.ActiveCell.FormulaR1C1 = " Основное место работы"
XLAp.Range("G9:G9").Select
XLAp.Selection.Interior.Color = 14922893
XLAp.ActiveCell.FormulaR1C1 = "Название подгруппы (Рус.)"
XLAp.Range("G10:G10").Select
XLAp.ActiveCell.FormulaR1C1 = "Название ресурса"
XLAp.Range("H9:K9").Select
XLAp.Selection.Interior.Color = 10147522
XLAp.ActiveCell.FormulaR1C1 = "Project 2007"
XLAp.Range("L9:P9").Select
XLAp.Selection.Interior.Color = 12106214
XLAp.ActiveCell.FormulaR1C1 = "Сервера"
XLAp.Range("H10:H10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Руководитель организации"
XLAp.Range("I10:I10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Руководитель ресурсов"
XLAp.Range("J10:J10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Руководитель проектов"
XLAp.Range("K10:K10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Участник групп"
XLAp.Range("L10:L10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "1С_User"
XLAp.Range("M10:M10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Terminal_user"
XLAp.Range("N10:N10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "VPN Доступ"
XLAp.Range("O10:O10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Интернет"
XLAp.Range("P10:P10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Почтовый ящик"
XLAp.Range("Q9:Q10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Доступ к USB портам"
XLAp.Range("R9:R10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Доступ к CD-RW"
XLAp.Range("S9:S10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Видеонаблюдение"
XLAp.Range("T9:T10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "ПО `БАРЬЕР`"
XLAp.Range("U9:V10").Select
XLAp.ActiveCell.FormulaR1C1 = "Примечание"
'---------------------------------------------------------------------------------------
'Начинаем заполнять таблицу значениями из AD
Set objGroup = GetObject("LDAP://CN=domen_all,OU=domen,DC=rdomen,DC=local")
objGroup.GetInfo
arrMemberOf = objGroup.GetEx("member")
' Перестановка значений массива
arMem0 = arrMemberOf(0)
arMem1 = arrMemberOf(1)
arMem2 = arrMemberOf(2)
arMem3 = arrMemberOf(3)
arrMemberOf(0) = arMem3
arrMemberOf(1) = arMem0
arrMemberOf(2) = arMem1
arrMemberOf(3) = arMem2
x = 12 ' Номер строки для вывода
razdel = 1 ' Счетчик раздела для нумерации разделов в таблице
BorderMainX = x ' Счетчик для выделения рамкой общей группы предприятия
For Each strMember in arrMemberOf
'Рисуем строку с названием основной группы красным цветом
XLAp.Rows(x).RowHeight = 15.00
XLAp.Range("B"&x &":C"&x).Merge
XLAp.Range("E"&x &":V"&x).Merge
XLAp.Range("B"&x &":V"&x).Select
XLAp.Selection.Font.Bold = True
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
XLAp.Selection.Borders.LineStyle = 1
XLAp.Selection.Borders.Weight = -4138
XLAp.Selection.Interior.Color = 4671487
'Обрезаем лишнее
tmpv = instr(1,strMember,",") - 1
tmpv1 = left(strMember,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
DescGr = GetDescript(strMember)
XLAp.Cells(x, 2).Value = razdel
XLAp.Cells(x, 4).Value = tmpv2
XLAp.Cells(x, 5).Value = DescGr
' Следующий вложенный цикл
Podrazdel1 = 1 ' Счетчик подраздела
Set objGroup2 = GetObject("LDAP://" & strMember)
objGroup2.GetInfo
arrMemberOf2 = objGroup2.GetEx("member")
Call quickSort( arrMemberOf2, 0, UBound( arrMemberOf2 ))
For Each strMember2 in arrMemberOf2
x = x + 2
tmpv = instr(1,strMember2,",") - 1
tmpv1 = left(strMember2,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
' Рисуем желтую ячейку
XLAp.Range("C"&x &":D"&x).Select
XLAp.Selection.NumberFormat = "@"
XLAp.Selection.Font.Bold = True
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.Borders.LineStyle = 1
XLAp.Selection.Borders.Weight = -4138
XLAp.Selection.Interior.Color = 65535
XLAp.Cells(x, 3).Value = razdel &"." &Podrazdel1
XLAp.Cells(x, 4).Value = tmpv2
' Начинаем следующий вложенный цикл
BorderPrazdelX = x +1 ' Записываем начальную координату х для рамки раздела
Podrazdel2 = 1 ' Счетчик подраздела
Set objGroup3 = GetObject("LDAP://" & strMember2)
objGroup3.GetInfo
arrMemberOf3 = objGroup3.GetEx("member")
Call quickSort( arrMemberOf3, 0, UBound( arrMemberOf3 )) 'Сортировка
For Each strMember3 in arrMemberOf3
x = x + 1
tmpv = instr(1,strMember3,",") - 1
tmpv1 = left(strMember3,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
'Рисуем голубую ячейку
XLAp.Range("D"&x &":U"&x).Select
XLAp.Selection.NumberFormat = "@"
XLAp.Selection.Font.Bold = True
XLAp.Selection.Borders.LineStyle = 1
XLAp.Selection.Borders.Weight = -4138
XLAp.Selection.Interior.Color = 14922893
XLAp.Cells(x, 4).Value = razdel &"." &Podrazdel1 &"." &Podrazdel2
XLAp.Cells(x, 5).Value = tmpv2
DescGr3 = GetDescript(strMember3)
XLAp.Cells(x, 7).Value = DescGr3
DescGr3 = ""
'ProjectOrgDir проверка -----------------------------------
strGp = "ProjectOrgDir"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 8).Value = "V"
End If
'ProjectResManager проверка -----------------------------
strGp = "ProjectResManager"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 9).Value = "V"
End If
'ProjectManProect проверка ------------------------------
strGp = "ProjectManProect"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 10).Value = "V"
End If
'ProjectUsers проверка -----------------------------------
strGp = "ProjectUsers"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 11).Value = "V"
End If
'1C_user проверка -----------------------------------
strGp = "1C_user"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 12).Value = "V"
End If
'Terminal_user проверка------------------------------
strGp = "Terminal_user"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 13).Value = "V"
End If
'Inet_User проверка ---------------------------------
strGp = "internet_user"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 15).Value = "V"
End If
' Начинаем следующий вложенный цикл, который выводит пользователей
Set objGroup4 = GetObject("LDAP://" & strMember3)
objGroup4.GetInfo
On Error Resume Next
'If Not (IsNull(objGroup4.GetInfo)) then
arrMemberOf4 = objGroup4.GetEx("member")
If Err.Number <> E_ADS_PROPERTY_NOT_FOUND Then
'XLAp.Cells(x, 25).Value = arrMemberOf4(0)
Call quickSort( arrMemberOf4, 0, UBound( arrMemberOf4 )) ' Сортировка
For Each strMember4 in arrMemberOf4
x = x + 1
tmpv = instr(1,strMember4,",") - 1
tmpv1 = left(strMember4,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
XLAp.Range("F"&x &":U"&x).Select
XLAp.Selection.Borders.LineStyle = 1
XLAp.Range("F"&x &":G"&x).Select
If DisabledAkk(strMember4) Then
'Выделяем красным отключенных пользователей
XLAp.Selection.Interior.Color = 4671487
End If
UsEmail = GetEmail(strMember4)
XLAp.Cells(x, 21).Value = UsEmail
UsEmail = ""
XLAp.Cells(x, 7).Value = tmpv2
'ProjectOrgDir проверка ----------------------------
strGp = "ProjectOrgDir"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 8).Value = "V"
End If
'ProjectResManager проверка ----------------------
strGp = "ProjectResManager"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 9).Value = "V"
End If
'ProjectManProect проверка ------------------------
strGp = "ProjectManProect"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 10).Value = "V"
End If
'ProjectUsers проверка -----------------------------
strGp = "ProjectUsers"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 11).Value = "V"
End If
'1C_user проверка ----------------------------------
strGp = "1C_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 12).Value = "V"
End If
'Terminal_user проверка ----------------------------
strGp = "Terminal_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 13).Value = "V"
End If
'VPN_user проверка --------------------------------
strGp = "VPN_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 14).Value = "V"
End If
'Inet_User проверка --------------------------------
strGp = "internet_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 15).Value = "V"
End If
'----------------------------------------------------
XLAp.Range("H"&x &":K"&x).Select
XLAp.Selection.Interior.Color = 10147522
XLAp.Range("L"&x &":P"&x).Select
XLAp.Selection.Interior.Color = 12106214
Next
arrMemberOf4 ="" ' сбрасываем в ноль для предотвращения повторений
End If
Podrazdel2 = Podrazdel2 + 1
' Выделяем рамкой раздел
XLAp.Range("D"&BorderPrazdelX &":U"&x).Select
BigBorder
XLAp.Range("E"&BorderPrazdelX &":E"&x).Select
BigBorder
XLAp.Range("G"&BorderPrazdelX &":G"&x).Select
BigBorder
XLAp.Range("F"&BorderPrazdelX &":F"&x).Select
BigBorder
XLAp.Range("H"&BorderPrazdelX &":K"&x).Select
BigBorder
XLAp.Range("L"&BorderPrazdelX &":P"&x).Select
BigBorder
XLAp.Range("Q"&BorderPrazdelX &":T"&x).Select
BigBorder
Next
Podrazdel1 = Podrazdel1 + 1
Next
razdel = razdel + 1
XLAp.Range("B"&BorderMainX &":V"&x+1).Select 'Рисуем рамку главной группы
BigBorder
x = x + 3 ' Делаем отступ для следующей группы
BorderMainX = x
Next
Function BigBorder()' Функция выделения раздела рамкой
XLAp.Selection.Borders(5).LineStyle = -4142
XLAp.Selection.Borders(6).LineStyle = -4142
With XLAp.Selection.Borders(7)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
With XLAp.Selection.Borders(8)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
With XLAp.Selection.Borders(9)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
With XLAp.Selection.Borders(10)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
End Function
Function GetDescript(LdpAd)' Функция возврата текстового поля description группы
Set oGroup = GetObject ("LDAP://" & LdpAd)
GetDescript = oGroup.Description
End Function
Function GetEmail(LdpAd)' Функция возврата текстового поля группы
On Error Resume Next
Set oGroup = GetObject ("LDAP://" & LdpAd)
GetEmail = oGroup.EmailAddress
Err.Clear
End Function
Function DisabledAkk(LdpAd)' Функция проверки отключен ли аккаунт
Set oGroup = GetObject ("LDAP://" & LdpAd)
DisabledAkk = oGroup.AccountDisabled
End Function
'--------------------------------------------------------------------------------
Function splitArray(anArray, leftBound, rightBound) ' Сортировка массива
Dim leftValue, rightValue, pivotValue, pivot, left, right
left = leftBound
pivot = left
right = rightBound
pivotValue = anArray( pivot )
Do while left < right
rightValue = anArray( right )
Do while pivotValue <= rightValue and left < right
right = right - 1
rightValue = anArray( right )
Loop
anArray( left ) = rightValue
leftValue = anArray( left )
Do while pivotValue > leftValue and left < right
left = left + 1
leftValue = anArray( left )
Loop
anArray( right ) = leftValue
Loop
anArray( left ) = pivotValue
splitArray = left
End function
' собственно сортировка
Function quickSort(anArray, leftBound, rightBound)
Dim splitIndex, left, right
left = leftBound
right = rightBound
If ( left < right ) then
splitIndex = splitArray( anArray, left, Right )
Call quickSort( anArray, left, splitIndex - 1 )
Call quickSort( anArray, splitIndex + 1, right )
End if
End Function
'------------------------------------------------------------
Function IsMember(ByVal objADObject, ByVal strGroup)
' Function to test for group membership.
' objADObject is a user or computer object.
' strGroup is the NT name (sAMAccountName) of the group to test.
' objGroupList is a dictionary object, with global scope.
' Returns True if the user or computer is a member of the group.
' Subroutine LoadGroups is called once for each different objADObject.
If (IsEmpty(objGroupList) = True) Then
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare
Call LoadGroups(objADObject)
End If
If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
Call LoadGroups(objADObject)
End If
IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
& strGroup)
End Function
Sub LoadGroups(ByVal objADObject)
' Subroutine to populate dictionary object with group memberships.
' objGroupList is a dictionary object, with global scope. It keeps track
' of group memberships for each user or computer separately.
Dim arrbytGroups, j
Dim arrstrGroupSids(), objGroup
objGroupList.Add objADObject.sAMAccountName & "\", True
objADObject.GetInfoEx Array("tokenGroups"), 0
arrbytGroups = objADObject.Get("tokenGroups")
If (TypeName(arrbytGroups) = "Byte()") Then
ReDim arrstrGroupSids(0)
arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
& ">")
objGroupList.Add objADObject.sAMAccountName & "\" _
& objGroup.sAMAccountName, True
Exit Sub
End If
If (UBound(arrbytGroups) = -1) Then
Exit Sub
End If
ReDim arrstrGroupSids(UBound(arrbytGroups))
For j = 0 To UBound(arrbytGroups)
arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
& ">")
objGroupList.Add objADObject.sAMAccountName & "\" _
& objGroup.sAMAccountName, True
Next
End Sub
Function OctetToHexStr(ByVal arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.
Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function
'------------------------------------------------------------------
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
'On Error Resume Next ' Не спотыкаться на ошибках
' Обьявляем массивы
Dim XLAp
Dim XLWb
Dim XLWs
Dim objADObject, strGroup, objGroupList
' Запускаем EXCEL
Set XLAp = CreateObject("Excel.Application")
XLAp.Visible = True
lst = 1
Set XLWb = XLAp.Workbooks.Add
Set XLWs = XLWb.Worksheets(lst)
XLWs.Activate
' Настройки листа EXCEL
XLAp.ActiveSheet.PageSetup.Zoom = 60
XLAp.ActiveSheet.PageSetup.PaperSize = 8
XLAp.ActiveSheet.PageSetup.CenterHorizontally = True
XLAp.ActiveSheet.PageSetup.LeftMargin = XLAp.Application.InchesToPoints(0.25)
XLAp.ActiveSheet.PageSetup.RightMargin = XLAp.Application.InchesToPoints(0.25)
XLAp.ActiveSheet.PageSetup.TopMargin = XLAp.Application.InchesToPoints(0.75)
XLAp.ActiveSheet.PageSetup.BottomMargin = XLAp.Application.InchesToPoints(0.75)
XLAp.ActiveSheet.PageSetup.HeaderMargin = XLAp.Application.InchesToPoints(0.3)
XLAp.ActiveSheet.PageSetup.FooterMargin = XLAp.Application.InchesToPoints(0.3)
' Выставляем длинну колонок
XLAp.Columns("A:A").ColumnWidth = 0.58
XLAp.Columns("B:C").ColumnWidth = 2.71
XLAp.Columns("D:D").ColumnWidth = 21.86
XLAp.Columns("E:E").ColumnWidth = 29.43
XLAp.Columns("F:F").ColumnWidth = 4.43
XLAp.Columns("G:G").ColumnWidth = 36.86
XLAp.Columns("H:T").ColumnWidth = 5.00
XLAp.Columns("U:U").ColumnWidth = 42.14
XLAp.Columns("V:V").ColumnWidth = 2.43
' Выставляем параметры столбцов
XLAp.Range("D:D").Select
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
XLAp.Selection.Font.Bold = True
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Range("H:T").Select
XLAp.Selection.Font.Bold = True
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
' Выставляем высоту ячеек
XLAp.Rows("1:1").RowHeight = 5.25
XLAp.Rows("2:2").RowHeight = 12.75
XLAp.Rows("3:3").RowHeight = 18.75
XLAp.Rows("7:7").RowHeight = 15.75
XLAp.Rows("4:6").RowHeight = 12.75
XLAp.Rows("10:10").RowHeight = 132.75
' Задаем шрифт и высоту строк ячеек
XLAp.Rows("13:255").Select
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Selection.RowHeight = 10.00
' Обьединяем ячейки
XLAp.Range("B7:V7").Merge
XLAp.Range("B10:C10").Merge
XLAp.Range("F9:F10").Merge
XLAp.Range("B9:C10").Merge
XLAp.Range("D9:D10").Merge
XLAp.Range("E9:E10").Merge
XLAp.Range("H9:K9").Merge
XLAp.Range("L9:P9").Merge
XLAp.Range("Q9:Q10").Merge
XLAp.Range("R9:R10").Merge
XLAp.Range("S9:S10").Merge
XLAp.Range("T9:T10").Merge
XLAp.Range("U9:V10").Merge
' Оформляем шапку таблицы
XLAp.Range("U2:U6").Select
With XLAp.Selection.Font
.Name = "Tahoma"
.Size = 10
End With
XLAp.Range("U2:U2").Select
XLAp.ActiveCell.FormulaR1C1 = "УТВЕРЖДАЮ"
XLAp.Range("U3:U3").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
XLAp.Range("U4:U4").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
XLAp.Range("U5:U5").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
XLAp.Range("U6:U6").Select
XLAp.ActiveCell.FormulaR1C1 = "__________________________________________"
' Красим, заполняем шапку таблицы
XLAp.Range("B7:V7").Select
With XLAp.Selection.Font
.Bold = True
.Name = "Calibri"
.Size = 16
End With
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
XLAp.ActiveCell.FormulaR1C1 = "Схема распределения прав пользователей в группах домена DOMEN.LOCAL"
XLAp.Range("B9:V10").Select
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
With XLAp.Selection.Font
.Bold = True
.Name = "Tahoma"
.Size = 8
End With
With XLAp.Selection.Borders
.LineStyle = 1
.Weight = -4138
End With
With XLAp.Selection.Interior
.ThemeColor = 1
.TintAndShade = -0.149998474074526
End With
XLAp.Range("B10:C10").Select
XLAp.ActiveCell.FormulaR1C1 = "№"
XLAp.Range("D9:D10").Select
XLAp.ActiveCell.FormulaR1C1 = "Название группы"
XLAp.Range("E9:E10").Select
XLAp.Selection.Interior.Color = 14922893
XLAp.ActiveCell.FormulaR1C1 = "Название подгруппы (Англ.)"
XLAp.Range("F9:F10").Select
XLAp.Selection.Orientation = -90
XLAp.Selection.Interior.Color = 14922893
XLAp.ActiveCell.FormulaR1C1 = " Основное место работы"
XLAp.Range("G9:G9").Select
XLAp.Selection.Interior.Color = 14922893
XLAp.ActiveCell.FormulaR1C1 = "Название подгруппы (Рус.)"
XLAp.Range("G10:G10").Select
XLAp.ActiveCell.FormulaR1C1 = "Название ресурса"
XLAp.Range("H9:K9").Select
XLAp.Selection.Interior.Color = 10147522
XLAp.ActiveCell.FormulaR1C1 = "Project 2007"
XLAp.Range("L9:P9").Select
XLAp.Selection.Interior.Color = 12106214
XLAp.ActiveCell.FormulaR1C1 = "Сервера"
XLAp.Range("H10:H10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Руководитель организации"
XLAp.Range("I10:I10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Руководитель ресурсов"
XLAp.Range("J10:J10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Руководитель проектов"
XLAp.Range("K10:K10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Участник групп"
XLAp.Range("L10:L10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "1С_User"
XLAp.Range("M10:M10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Terminal_user"
XLAp.Range("N10:N10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "VPN Доступ"
XLAp.Range("O10:O10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Интернет"
XLAp.Range("P10:P10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Почтовый ящик"
XLAp.Range("Q9:Q10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Доступ к USB портам"
XLAp.Range("R9:R10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Доступ к CD-RW"
XLAp.Range("S9:S10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "Видеонаблюдение"
XLAp.Range("T9:T10").Select
XLAp.Selection.Orientation = -90
XLAp.ActiveCell.FormulaR1C1 = "ПО `БАРЬЕР`"
XLAp.Range("U9:V10").Select
XLAp.ActiveCell.FormulaR1C1 = "Примечание"
'---------------------------------------------------------------------------------------
'Начинаем заполнять таблицу значениями из AD
Set objGroup = GetObject("LDAP://CN=domen_all,OU=domen,DC=rdomen,DC=local")
objGroup.GetInfo
arrMemberOf = objGroup.GetEx("member")
' Перестановка значений массива
arMem0 = arrMemberOf(0)
arMem1 = arrMemberOf(1)
arMem2 = arrMemberOf(2)
arMem3 = arrMemberOf(3)
arrMemberOf(0) = arMem3
arrMemberOf(1) = arMem0
arrMemberOf(2) = arMem1
arrMemberOf(3) = arMem2
x = 12 ' Номер строки для вывода
razdel = 1 ' Счетчик раздела для нумерации разделов в таблице
BorderMainX = x ' Счетчик для выделения рамкой общей группы предприятия
For Each strMember in arrMemberOf
'Рисуем строку с названием основной группы красным цветом
XLAp.Rows(x).RowHeight = 15.00
XLAp.Range("B"&x &":C"&x).Merge
XLAp.Range("E"&x &":V"&x).Merge
XLAp.Range("B"&x &":V"&x).Select
XLAp.Selection.Font.Bold = True
XLAp.Selection.Font.Name = "Tahoma"
XLAp.Selection.Font.Size = 8
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.VerticalAlignment = -4108
XLAp.Selection.Borders.LineStyle = 1
XLAp.Selection.Borders.Weight = -4138
XLAp.Selection.Interior.Color = 4671487
'Обрезаем лишнее
tmpv = instr(1,strMember,",") - 1
tmpv1 = left(strMember,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
DescGr = GetDescript(strMember)
XLAp.Cells(x, 2).Value = razdel
XLAp.Cells(x, 4).Value = tmpv2
XLAp.Cells(x, 5).Value = DescGr
' Следующий вложенный цикл
Podrazdel1 = 1 ' Счетчик подраздела
Set objGroup2 = GetObject("LDAP://" & strMember)
objGroup2.GetInfo
arrMemberOf2 = objGroup2.GetEx("member")
Call quickSort( arrMemberOf2, 0, UBound( arrMemberOf2 ))
For Each strMember2 in arrMemberOf2
x = x + 2
tmpv = instr(1,strMember2,",") - 1
tmpv1 = left(strMember2,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
' Рисуем желтую ячейку
XLAp.Range("C"&x &":D"&x).Select
XLAp.Selection.NumberFormat = "@"
XLAp.Selection.Font.Bold = True
XLAp.Selection.HorizontalAlignment = -4108
XLAp.Selection.Borders.LineStyle = 1
XLAp.Selection.Borders.Weight = -4138
XLAp.Selection.Interior.Color = 65535
XLAp.Cells(x, 3).Value = razdel &"." &Podrazdel1
XLAp.Cells(x, 4).Value = tmpv2
' Начинаем следующий вложенный цикл
BorderPrazdelX = x +1 ' Записываем начальную координату х для рамки раздела
Podrazdel2 = 1 ' Счетчик подраздела
Set objGroup3 = GetObject("LDAP://" & strMember2)
objGroup3.GetInfo
arrMemberOf3 = objGroup3.GetEx("member")
Call quickSort( arrMemberOf3, 0, UBound( arrMemberOf3 )) 'Сортировка
For Each strMember3 in arrMemberOf3
x = x + 1
tmpv = instr(1,strMember3,",") - 1
tmpv1 = left(strMember3,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
'Рисуем голубую ячейку
XLAp.Range("D"&x &":U"&x).Select
XLAp.Selection.NumberFormat = "@"
XLAp.Selection.Font.Bold = True
XLAp.Selection.Borders.LineStyle = 1
XLAp.Selection.Borders.Weight = -4138
XLAp.Selection.Interior.Color = 14922893
XLAp.Cells(x, 4).Value = razdel &"." &Podrazdel1 &"." &Podrazdel2
XLAp.Cells(x, 5).Value = tmpv2
DescGr3 = GetDescript(strMember3)
XLAp.Cells(x, 7).Value = DescGr3
DescGr3 = ""
'ProjectOrgDir проверка -----------------------------------
strGp = "ProjectOrgDir"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 8).Value = "V"
End If
'ProjectResManager проверка -----------------------------
strGp = "ProjectResManager"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 9).Value = "V"
End If
'ProjectManProect проверка ------------------------------
strGp = "ProjectManProect"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 10).Value = "V"
End If
'ProjectUsers проверка -----------------------------------
strGp = "ProjectUsers"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 11).Value = "V"
End If
'1C_user проверка -----------------------------------
strGp = "1C_user"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 12).Value = "V"
End If
'Terminal_user проверка------------------------------
strGp = "Terminal_user"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 13).Value = "V"
End If
'Inet_User проверка ---------------------------------
strGp = "internet_user"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 15).Value = "V"
End If
' Начинаем следующий вложенный цикл, который выводит пользователей
Set objGroup4 = GetObject("LDAP://" & strMember3)
objGroup4.GetInfo
On Error Resume Next
'If Not (IsNull(objGroup4.GetInfo)) then
arrMemberOf4 = objGroup4.GetEx("member")
If Err.Number <> E_ADS_PROPERTY_NOT_FOUND Then
'XLAp.Cells(x, 25).Value = arrMemberOf4(0)
Call quickSort( arrMemberOf4, 0, UBound( arrMemberOf4 )) ' Сортировка
For Each strMember4 in arrMemberOf4
x = x + 1
tmpv = instr(1,strMember4,",") - 1
tmpv1 = left(strMember4,tmpv)
tmpv2 = right(tmpv1, len(tmpv1) - 3)
XLAp.Range("F"&x &":U"&x).Select
XLAp.Selection.Borders.LineStyle = 1
XLAp.Range("F"&x &":G"&x).Select
If DisabledAkk(strMember4) Then
'Выделяем красным отключенных пользователей
XLAp.Selection.Interior.Color = 4671487
End If
UsEmail = GetEmail(strMember4)
XLAp.Cells(x, 21).Value = UsEmail
UsEmail = ""
XLAp.Cells(x, 7).Value = tmpv2
'ProjectOrgDir проверка ----------------------------
strGp = "ProjectOrgDir"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 8).Value = "V"
End If
'ProjectResManager проверка ----------------------
strGp = "ProjectResManager"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 9).Value = "V"
End If
'ProjectManProect проверка ------------------------
strGp = "ProjectManProect"
Set objADus = GetObject("LDAP://" & strMember3)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 10).Value = "V"
End If
'ProjectUsers проверка -----------------------------
strGp = "ProjectUsers"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 11).Value = "V"
End If
'1C_user проверка ----------------------------------
strGp = "1C_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 12).Value = "V"
End If
'Terminal_user проверка ----------------------------
strGp = "Terminal_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 13).Value = "V"
End If
'VPN_user проверка --------------------------------
strGp = "VPN_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 14).Value = "V"
End If
'Inet_User проверка --------------------------------
strGp = "internet_user"
Set objADus = GetObject("LDAP://" & strMember4)
If (IsMember(objADus, strGp) = True) Then
XLAp.Cells(x, 15).Value = "V"
End If
'----------------------------------------------------
XLAp.Range("H"&x &":K"&x).Select
XLAp.Selection.Interior.Color = 10147522
XLAp.Range("L"&x &":P"&x).Select
XLAp.Selection.Interior.Color = 12106214
Next
arrMemberOf4 ="" ' сбрасываем в ноль для предотвращения повторений
End If
Podrazdel2 = Podrazdel2 + 1
' Выделяем рамкой раздел
XLAp.Range("D"&BorderPrazdelX &":U"&x).Select
BigBorder
XLAp.Range("E"&BorderPrazdelX &":E"&x).Select
BigBorder
XLAp.Range("G"&BorderPrazdelX &":G"&x).Select
BigBorder
XLAp.Range("F"&BorderPrazdelX &":F"&x).Select
BigBorder
XLAp.Range("H"&BorderPrazdelX &":K"&x).Select
BigBorder
XLAp.Range("L"&BorderPrazdelX &":P"&x).Select
BigBorder
XLAp.Range("Q"&BorderPrazdelX &":T"&x).Select
BigBorder
Next
Podrazdel1 = Podrazdel1 + 1
Next
razdel = razdel + 1
XLAp.Range("B"&BorderMainX &":V"&x+1).Select 'Рисуем рамку главной группы
BigBorder
x = x + 3 ' Делаем отступ для следующей группы
BorderMainX = x
Next
Function BigBorder()' Функция выделения раздела рамкой
XLAp.Selection.Borders(5).LineStyle = -4142
XLAp.Selection.Borders(6).LineStyle = -4142
With XLAp.Selection.Borders(7)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
With XLAp.Selection.Borders(8)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
With XLAp.Selection.Borders(9)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
With XLAp.Selection.Borders(10)
.LineStyle = 1
.ColorIndex = 0
.TintAndShade = 0
.Weight = -4138
End With
End Function
Function GetDescript(LdpAd)' Функция возврата текстового поля description группы
Set oGroup = GetObject ("LDAP://" & LdpAd)
GetDescript = oGroup.Description
End Function
Function GetEmail(LdpAd)' Функция возврата текстового поля группы
On Error Resume Next
Set oGroup = GetObject ("LDAP://" & LdpAd)
GetEmail = oGroup.EmailAddress
Err.Clear
End Function
Function DisabledAkk(LdpAd)' Функция проверки отключен ли аккаунт
Set oGroup = GetObject ("LDAP://" & LdpAd)
DisabledAkk = oGroup.AccountDisabled
End Function
'--------------------------------------------------------------------------------
Function splitArray(anArray, leftBound, rightBound) ' Сортировка массива
Dim leftValue, rightValue, pivotValue, pivot, left, right
left = leftBound
pivot = left
right = rightBound
pivotValue = anArray( pivot )
Do while left < right
rightValue = anArray( right )
Do while pivotValue <= rightValue and left < right
right = right - 1
rightValue = anArray( right )
Loop
anArray( left ) = rightValue
leftValue = anArray( left )
Do while pivotValue > leftValue and left < right
left = left + 1
leftValue = anArray( left )
Loop
anArray( right ) = leftValue
Loop
anArray( left ) = pivotValue
splitArray = left
End function
' собственно сортировка
Function quickSort(anArray, leftBound, rightBound)
Dim splitIndex, left, right
left = leftBound
right = rightBound
If ( left < right ) then
splitIndex = splitArray( anArray, left, Right )
Call quickSort( anArray, left, splitIndex - 1 )
Call quickSort( anArray, splitIndex + 1, right )
End if
End Function
'------------------------------------------------------------
Function IsMember(ByVal objADObject, ByVal strGroup)
' Function to test for group membership.
' objADObject is a user or computer object.
' strGroup is the NT name (sAMAccountName) of the group to test.
' objGroupList is a dictionary object, with global scope.
' Returns True if the user or computer is a member of the group.
' Subroutine LoadGroups is called once for each different objADObject.
If (IsEmpty(objGroupList) = True) Then
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare
Call LoadGroups(objADObject)
End If
If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
Call LoadGroups(objADObject)
End If
IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
& strGroup)
End Function
Sub LoadGroups(ByVal objADObject)
' Subroutine to populate dictionary object with group memberships.
' objGroupList is a dictionary object, with global scope. It keeps track
' of group memberships for each user or computer separately.
Dim arrbytGroups, j
Dim arrstrGroupSids(), objGroup
objGroupList.Add objADObject.sAMAccountName & "\", True
objADObject.GetInfoEx Array("tokenGroups"), 0
arrbytGroups = objADObject.Get("tokenGroups")
If (TypeName(arrbytGroups) = "Byte()") Then
ReDim arrstrGroupSids(0)
arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
& ">")
objGroupList.Add objADObject.sAMAccountName & "\" _
& objGroup.sAMAccountName, True
Exit Sub
End If
If (UBound(arrbytGroups) = -1) Then
Exit Sub
End If
ReDim arrstrGroupSids(UBound(arrbytGroups))
For j = 0 To UBound(arrbytGroups)
arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
& ">")
objGroupList.Add objADObject.sAMAccountName & "\" _
& objGroup.sAMAccountName, True
Next
End Sub
Function OctetToHexStr(ByVal arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.
Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function
'------------------------------------------------------------------
В результате выполнения скрипта имеем документ в EXCEL, который сразу можно отправлять на принтер:
Некоторые особенности:
1) Значение некоторых свойств и методов можно подсмотреть в режиме записи макроса (т.е. записать макрос и посмотреть какие свойства и методы применяются).
2) Для запуска скрипта в системе должен быть установлен принтер и компьютер, на котором запускается скрипт, должен быть в домене Active Directory.
1) Значение некоторых свойств и методов можно подсмотреть в режиме записи макроса (т.е. записать макрос и посмотреть какие свойства и методы применяются).
2) Для запуска скрипта в системе должен быть установлен принтер и компьютер, на котором запускается скрипт, должен быть в домене Active Directory.
В случае если все пользователи находятся в отдельных OU то скрипт необходимо глобально переделывать иначе не работает
ОтветитьУдалить