1

Тема: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Здравствуйте!

В скрипте: Серый форум / VBS: Выгрузка данных из Active Directory я изменил строку определяющую, что выгружать на следующую:

strCommandText = "SELECT mDBOverQuotaLimit,mDBStorageQuota,telephoneNumber,userPrincipalName,sAMAccountName,displayName

В общем это просто перебор параметров на искомые, но я не нашел переменную отвечающую за Description пользователей.

Домен 2003.
Спасибо!

2

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

bnp322 пишет:

... но я не нашел переменную отвечающую за Description пользователей

Нужный вам атрибут имеется в схеме и носит именно такое название.

3

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Нужный вам атрибут имеется в схеме и носит именно такое название.

Но с этим атрибутом скрипт не выполняется - ошибка:
Несоответствие типа
код: 800a000d

4

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

bnp322 пишет:

... ошибка:
Несоответствие типа
код: 800a000d

В какой строке?

5

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Dmitrii пишет:

В какой строке?

В строке 37 !?
символ 9

Если я заменяю:

        If Len(strTemp) > 0 Then
            objWSheet.Cells(intRow, intColumn).Value = strTemp
        End If
на:

objWSheet.Cells(intRow, intColumn).Value = strTemp
Все работает!

Как лучше поступить?

6

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

bnp322, это прелестно — Вы не находите? По приведённой ссылке несколько скриптов. Будем гадать в каком скрипте строка 37? Приведите Ваш код, приведите сообщение об ошибке.

И не забывайте: код оформляется тэгом «code».

7 (изменено: bnp322, 2010-11-10 11:32:45)

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

alexii пишет:

bnp322, это прелестно — Вы не находите? По приведённой ссылке несколько скриптов. Будем гадать в каком скрипте строка 37? Приведите Ваш код, приведите сообщение об ошибке.

И не забывайте: код оформляется тэгом «code».

Я использую предпоследний скрипт, закоментировав лишние для меня окна:

Dim objRoot, strDomain
Dim objConnection, objCommand, objRSet
Dim objFS, objExcel, objWB, objWSheet, strBook, intRow, intColumn, strTemp
Const ADS_SCOPE_SUBTREE = 2
strBook = "Users.xls"
intRow = 2
Set objExcel  = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWB = objExcel.Workbooks.Add
Set objWSheet = objWB.Worksheets(1)
Set objFS = CreateObject("Scripting.FileSystemObject")
strBook = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strBook)
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "description"
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strCommandText = "SELECT mDBOverQuotaLimit,mDBStorageQuota,telephoneNumber,userPrincipalName,description,GivenName,sn FROM 'LDAP://" & strDomain & "' WHERE objectCategory='Person' AND objectClass='User'"
objCommand.CommandText = strCommandText
Set objRSet = objCommand.Execute
objRSet.MoveFirst
Do
    If intRow = 2 Then
        For intColumn = 1 To objRSet.Fields.Count
            objWSheet.Cells(intRow - 1, intColumn).Value = UCase(objRSet.Fields(intColumn - 1).Name)
        Next
    End If
    For intColumn = 1 To objRSet.Fields.Count
        strTemp = objRSet.Fields(intColumn - 1).Value
      If Len(strTemp) > 0 Then
            objWSheet.Cells(intRow, intColumn).Value = strTemp
     End If
    Next
    intRow = intRow + 1
    objWSheet.Cells(intRow, 1).Activate 'своего рода индикатор процесса
    objRSet.MoveNext
Loop While Not objRSet.EOF
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
Set objFS = Nothing
objExcel.DisplayAlerts = False 'позволяет отключить запрос на выбор действия в случае,
                                             'когда файл уже существует
objWSheet.Columns.AutoFit
objWB.SaveAs strBook
'objWB.Close
'objExcel.Quit
Set objWSheet = Nothing
Set objWB = Nothing
Set objExcel = Nothing
'WScript.Echo "Готово."
WScript.Quit 0

Ошибка:

Строка:    37
Символ:    7
Ошибка:    Несоответствие типа
Код:    800A000D
Источник:     Ошибка выполнения Microsoft VBScript

8

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Тип возвращаемых данных надо проверять. В данном случае, «description» — это массив, т.е., например:

If IsArray(strTemp) Then
    For Each elem In strTemp
        objWSheet.Cells(intRow, intColumn).Value = objWSheet.Cells(intRow, intColumn).Value & elem & vbLf
    Next
Else
    If Len(strTemp) > 0 Then
        objWSheet.Cells(intRow, intColumn).Value = strTemp
    End If
End If

Правильнее, конечно, сразу проверять тип возвращаемых данных, т.е. objRSet.Fields().Item().Type.

9

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Я так понимаю, что автор скрипта пытался отловить пустые значения, тогда можно и так (мне не доводилось видеть на практике многострочных Description, а проверять специально лень ):

If Not IsNull(strTemp) Then
    objWSheet.Cells(intRow, intColumn).Value = strTemp
End If

10

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Работает!!!

Вопрос из любопытства:
параметр telephoneNumber почему выгружается без знака +
стоящего перед номером.

11 (изменено: Dmitrii, 2010-11-10 16:43:44)

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

alexii пишет:

Тип возвращаемых данных надо проверять...

В исходном сценарии в этом не было большого смысла, т.к. значения всех просматриваемых в нём атрибутов имеют строковый тип. При этом, значение ни одного из них не может быть многострочным. А вот проверку на NULL вместо определения длины строки, действительно, надо было сделать. Виноват.

bnp322 пишет:

... параметр telephoneNumber почему выгружается без знака +
стоящего перед номером.

Речь об отображении значений в книге Excel?
Если так, то всё просто - номер телефона воспринимается как числовое значение и "плюс" (по умолчанию) опускается.
Варианты решения:
- использовать в номере телефона строковые символы (например, +7(495)1112233);
- настроить соответствующим образом формат тех ячеек, где будет отображаться номер (например, указать формат "Текстовый");
- ставить перед значением номера специальный символ "прямой апостроф", что равносильно указанию на текстовый формат данных в ячейке

objWSheet.Cells(intRow, intColumn).Value = "'" & strTemp

12

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Dmitrii пишет:

В исходном сценарии в этом не было большого смысла, т.к. значения всех просматриваемых в нём атрибутов имеют строковый тип. При этом, значение ни одного из них не может быть многострочным. А вот проверку на NULL вместо определения длины строки, действительно, надо было сделать. Виноват.

Угу, так что, извиняться не за что . Я просто не смотрел в оригинал — там хватало.

13

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Dmitrii пишет:

Речь об отображении значений в книге Excel?
Если так, то всё просто - номер телефона воспринимается как числовое значение и "плюс" (по умолчанию) опускается.
Варианты решения:
- использовать в номере телефона строковые символы (например, +7(495)1112233);
- настроить соответствующим образом формат тех ячеек, где будет отображаться номер (например, указать формат "Текстовый");
- ставить перед значением номера специальный символ "прямой апостроф", что равносильно указанию на текстовый формат данных в ячейке

objWSheet.Cells(intRow, intColumn).Value = "'" & strTemp

Да в Excel.

Я сделал изменения в скрипте:

Dim objRoot, strDomain
Dim objConnection, objCommand, objRSet
Dim objFS, objExcel, objWB, objWSheet, strBook, intRow, intColumn, strTemp
Const ADS_SCOPE_SUBTREE = 2
strBook = "Users.xls"
intRow = 2
Set objExcel  = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWB = objExcel.Workbooks.Add
Set objWSheet = objWB.Worksheets(1)
Set objFS = CreateObject("Scripting.FileSystemObject")
strBook = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strBook)
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "description"
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strCommandText = "SELECT mDBOverQuotaLimit,mDBStorageQuota,telephoneNumber,userPrincipalName,description,GivenName,sn FROM 'LDAP://" & strDomain & "' WHERE objectCategory='Person' AND objectClass='User'"
objCommand.CommandText = strCommandText
Set objRSet = objCommand.Execute
objRSet.MoveFirst
Do

    If intRow = 2 Then
        For intColumn = 1 To objRSet.Fields.Count
            objWSheet.Cells(intRow - 1, intColumn).Value = UCase(objRSet.Fields(intColumn - 1).Name)
        Next
    End If
    For intColumn = 1 To objRSet.Fields.Count
        strTemp = objRSet.Fields(intColumn - 1).Value
    If Not IsNull(strTemp) Then
    objWSheet.Cells(intRow, intColumn).Value = "'" & strTemp
    End If

    Next
    intRow = intRow + 1
    objWSheet.Cells(intRow, 1).Activate 'своего рода индикатор процесса
    objRSet.MoveNext
Loop While Not objRSet.EOF
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
Set objFS = Nothing
objExcel.DisplayAlerts = False 'позволяет отключить запрос на выбор действия в случае,
                                             'когда файл уже существует
objWSheet.Columns.AutoFit
objWB.SaveAs strBook
'objWB.Close
'objExcel.Quit
Set objWSheet = Nothing
Set objWB = Nothing
Set objExcel = Nothing
'WScript.Echo "Готово."
WScript.Quit 0

И он выдает другую ошибку, вероятно я делаю не то?:


Строка:    39
Символ:    5
Ошибка:    Несоответствие типа
Код:    800A000D
Источник:     Ошибка выполнения Microsoft VBScript

14

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

См. выше. То есть, наподобие:

If Not IsNull(strTemp) Then
    If IsArray(strTemp) Then
        objWSheet.Cells(intRow, intColumn).Value = "'" & Join(strTemp, vbLf)
    Else
        objWSheet.Cells(intRow, intColumn).Value = "'" & strTemp
    End If
End If

15

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Да все получилось, хорошо!
Но я посмотрел... лучше без символа ' в каждой ячейки, чем номера телефонов без + !

Спасибо!

16 (изменено: Dmitrii, 2010-11-11 16:58:48)

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

bnp322 пишет:

... лучше без символа ' в каждой ячейки, чем номера телефонов без +

Вы не обратили должного внимания на второй из указанных способов. Между тем, его использование позволяет и "плюс" сохранить, и дополнительных символов не использовать.
Реализация очень проста:

If Not IsNull(strTemp) Then
    '===
    objWSheet.Cells(intRow, intColumn).NumberFormat = "@"
    '===
    If IsArray(strTemp) Then
        objWSheet.Cells(intRow, intColumn).Value = Join(strTemp, vbLf)
    Else
        objWSheet.Cells(intRow, intColumn).Value = strTemp
    End If
End If

17

Re: VBS: Модифицировать скрипт: выгрузить данные из Active Directory

Да! Это идеально!   Спасибо, в конечном виде так:

Dim objRoot, strDomain
Dim objConnection, objCommand, objRSet
Dim objFS, objExcel, objWB, objWSheet, strBook, intRow, intColumn, strTemp
Const ADS_SCOPE_SUBTREE = 2
strBook = "Users.xls"
intRow = 2
Set objExcel  = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWB = objExcel.Workbooks.Add
Set objWSheet = objWB.Worksheets(1)
Set objFS = CreateObject("Scripting.FileSystemObject")
strBook = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strBook)
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "description"
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
strCommandText = _
"SELECT mDBOverQuotaLimit,mDBStorageQuota,telephoneNumber,userPrincipalName,description,GivenName,sn FROM 'LDAP://" _
& strDomain & "' WHERE objectCategory='Person' AND objectClass='User'"
objCommand.CommandText = strCommandText
Set objRSet = objCommand.Execute
objRSet.MoveFirst
Do

    If intRow = 2 Then
        For intColumn = 1 To objRSet.Fields.Count
            objWSheet.Cells(intRow - 1, intColumn).Value = UCase(objRSet.Fields(intColumn - 1).Name)
        Next
    End If
    For intColumn = 1 To objRSet.Fields.Count
        strTemp = objRSet.Fields(intColumn - 1).Value
If Not IsNull(strTemp) Then
    objWSheet.Cells(intRow, intColumn).NumberFormat = "@"
    If IsArray(strTemp) Then
        objWSheet.Cells(intRow, intColumn).Value = Join(strTemp, vbLf)
    Else
        objWSheet.Cells(intRow, intColumn).Value = strTemp
End If
    End If
    Next
    intRow = intRow + 1
    objWSheet.Cells(intRow, 1).Activate 'своего рода индикатор процесса
    objRSet.MoveNext
Loop While Not objRSet.EOF
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
Set objFS = Nothing
objExcel.DisplayAlerts = False 'позволяет отключить запрос на выбор действия в случае,
                                             'когда файл уже существует
objWSheet.Columns.AutoFit
objWB.SaveAs strBook
'objWB.Close
'objExcel.Quit
Set objWSheet = Nothing
Set objWB = Nothing
Set objExcel = Nothing
'WScript.Echo "Готово."
WScript.Quit 0