none
Вывод данных в HTML и Excel таблицы RRS feed

  • Вопрос

  • Здравствуйте у меня такая проблема! Необходимо вывести пользователей сети и к каким группам они относятся. А результат показать в HTML и Excel таблице.
    Вот есть скрипт который создает Excel таблицу и выводит пользователей и группы, но проблема в том что он выводит только одну группу к которой относится пользователь когда он находится в нескольких.
    Const ADS_SCOPE_SUBTREE = 2
    
    
    
    Set objExcel = CreateObject("Excel.Application")
    
    
    
    objExcel.Visible = True
    
    objExcel.Workbooks.Add
    
    
    
    objExcel.Cells(1, 1).Value = "Full name"
    
    objExcel.Cells(1, 2).Value = "Фамилия"
    
    objExcel.Cells(1, 3).Value = "Имя"
    
    objExcel.Cells(1, 4).Value = "Группы"
    
    
    
    Set objConnection = CreateObject("ADODB.Connection")
    
    Set objCommand =   CreateObject("ADODB.Command")
    
    objConnection.Provider = "ADsDSOObject"
    
    objConnection.Open "Active Directory Provider"
    
    
    
    Set objCommand.ActiveConnection = objConnection
    
    objCommand.Properties("Page Size") = 100
    
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
    
    objCommand.CommandText = _
    
        "SELECT displayName, memberOf, givenName, sn FROM " _
    
            & "'LDAP://CN=Users,DC=test,DC=local' WHERE " _
    
                & "objectCategory='user'"  
    
    Set objRecordSet = objCommand.Execute
    
    objRecordSet.MoveFirst
    
    x = 2
    
    
    
    Do Until objRecordSet.EOF
    
        objExcel.Cells(x, 1).Value = _
    
            objRecordSet.Fields("displayName").Value
    
        objExcel.Cells(x, 2).Value = _
    
            objRecordSet.Fields("givenName").Value
    
        objExcel.Cells(x, 3).Value = _
    
            objRecordSet.Fields("sn").Value
    
        objExcel.Cells(x, 4).Value = _
    
            objRecordSet.Fields("memberOf").Value
    
        x = x + 1
    
        objRecordSet.MoveNext
    
    Loop
    
    
    
    Set objRange = objExcel.Range("A1")
    
    objRange.Activate
    
    
    
    Set objRange = objExcel.ActiveCell.EntireColumn
    
    objRange.Autofit()
    
    
    
    Set objRange = objExcel.Range("B1")
    
    objRange.Activate
    
    Set objRange = objExcel.ActiveCell.EntireColumn
    
    objRange.Autofit()
    
    
    
    Set objRange = objExcel.Range("C1")
    
    objRange.Activate
    
    
    
    Set objRange = objExcel.ActiveCell.EntireColumn
    
    objRange.Autofit()
    
    
    
    Set objRange = objExcel.Range("D1")
    
    objRange.Activate
    
    
    
    Set objRange = objExcel.ActiveCell.EntireColumn
    
    objRange.Autofit()
    
    
    
    Set objRange = objExcel.Range("A1").SpecialCells(11)
    
    Set objRange2 = objExcel.Range("C1")
    
    Set objRange3 = objExcel.Range("A1")


    Помогите пожалуйста! Может в этот скрипт что-то добавить нужно ?
    За ранее спасибо!

Ответы

  • например так:

    On Error Resume Next
    Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
    
    Dim fsObj, fileObj
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set fileObj = fsObj.CreateTextFile("C:\userlist.htm", True)
    fileObj.WriteLine("<HTML><BODY><TABLE >")
    
    Set objComputer = GetObject _
        ("LDAP://CN=users,DC=test,DC=local")
     
    ObjComputer.Filter= Array("user")
     
    
    dim members_str
    members_str = ""
    
    For Each objUser in objComputer
    
        fileObj.WriteLine("<tr><td>" & objUser.Fullname & "</td>")
        WScript.Echo "Fullname: " & objUser.Fullname
        WScript.Echo objUser.cn & " is a member of: "
     
        arrMemberOf = objUser.GetEx("memberOf")
     
    
        If Err.Number <>  E_ADS_PROPERTY_NOT_FOUND Then
            For Each Group in arrMemberOf
                 members_str = members_str & Group & "</br>"
    	     WScript.Echo vbTab & Group
            Next
        Else
            members_str = "Группы не найдены"
            Err.Clear
          End If
            
        fileObj.WriteLine("<td>" & members_str & "</td></tr>")
        members_str = ""
        Wscript.Echo VbCrLf
    Next
    fileObj.WriteLine("</TABLE></BODY></HTML>")

    mcp, mcdba, mcsa, mcse, ccna
    • Помечено в качестве ответа Leonid19 27 мая 2009 г. 10:59

Все ответы

  • вообще для выполнение этой задачи вы можете использовать утилиту csvde
    например так:
    csvde -f c:\userlist.txt -d "CN=Users,DC=test,DC=local" -r "(ObjectCategory=user)" -l "displayName, memberOf, givenName, sn"

    данная команда экспортирует объекты пользователей в файл с разделителем - запятая..
    этот файл можно открыть при помощи Excel
    mcp, mcdba, mcsa, mcse, ccna
  • либо перепишите этот скрипт следующим образом:

    x = 2
    
    dim members
    dim members_str
    members_str = ""
    
    Do Until objRecordSet.EOF
        objExcel.Cells(x, 1).Value = _
            objRecordSet.Fields("displayName").Value
    
        objExcel.Cells(x, 2).Value = _
            objRecordSet.Fields("givenName").Value
    
        objExcel.Cells(x, 3).Value = _
            objRecordSet.Fields("sn").Value
    
        members = objRecordSet.Fields("memberOf").Value
    
        if IsArray(members) then
        for each member in members
    	members_str = members_str & member & ";"
        Next
        else
            members_str = members
        end if
    
        objExcel.Cells(x, 4).Value = members_str
        members_str = ""
    		
        x = x + 1
        objRecordSet.MoveNext
    
    Loop
    

    mcp, mcdba, mcsa, mcse, ccna
  • Он теперь вообще не выводит! Открывает Excel, а таблицу не заполняет!
  • ошибки какие-нибудь есть при выполнении?
    mcp, mcdba, mcsa, mcse, ccna
  • Ошибок не выдает! я воспользовался вторым способом! Может написать в начале On Error Resume Next?

    • Изменено Leonid19 26 мая 2009 г. 7:32
  • хм.. странно.. у меня выполняется без проблем..
    должны быть ошибки если чтото не так..
    убедитесь что вы вставляете этот фрагмент в правильное место :)
    mcp, mcdba, mcsa, mcse, ccna
  • Я его вставляю вместо


    x = 2



    Do Until objRecordSet.EOF

        objExcel.Cells(x, 1).Value = _

            objRecordSet.Fields("displayName").Value

        objExcel.Cells(x, 2).Value = _

            objRecordSet.Fields("givenName").Value

        objExcel.Cells(x, 3).Value = _

            objRecordSet.Fields("sn").Value

        objExcel.Cells(x, 4).Value = _

            objRecordSet.Fields("memberOf").Value

        x = x + 1

        objRecordSet.MoveNext

    Loop


    или вместо другого нада?
  • да нет.. вроде все правильно..
    mcp, mcdba, mcsa, mcse, ccna
  • покажите ваш итоговый код..
    mcp, mcdba, mcsa, mcse, ccna
  • оо ошибку выдал
    Строка: 25
    Символ: 1
    Ошибка: Был принят недопустимый путь к службе каталогов Active Directory
    Код: 80040E37
  • а что у вас в 25 строке?
    mcp, mcdba, mcsa, mcse, ccna
  • Вот скрипт который получился


    Const ADS_SCOPE_SUBTREE = 2

    Set objExcel = CreateObject("Excel.Application")

    objExcel.Visible = True
    objExcel.Workbooks.Add

    objExcel.Cells(1, 1).Value = "Full name"
    objExcel.Cells(1, 2).Value = "Фамилия"
    objExcel.Cells(1, 3).Value = "Имя"
    objExcel.Cells(1, 4).Value = "Группы"

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand =   CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 100
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = _
        "SELECT displayName, memberOf, givenName, sn FROM " _
            & "'LDAP://CN=Users,DC=test,DC=local' WHERE " _
                & "objectCategory='user'" 
    Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    x = 2

    dim members
    dim members_str
    members_str = ""

    Do Until objRecordSet.EOF
        objExcel.Cells(x, 1).Value = _
            objRecordSet.Fields("displayName").Value

        objExcel.Cells(x, 2).Value = _
            objRecordSet.Fields("givenName").Value

        objExcel.Cells(x, 3).Value = _
            objRecordSet.Fields("sn").Value

        members = objRecordSet.Fields("memberOf").Value

        if IsArray(members) then
        for each member in members
     members_str = members_str & member & ";"
        Next
        else
            members_str = members
        end if

        objExcel.Cells(x, 4).Value = members_str
        members_str = ""
      
        x = x + 1
        objRecordSet.MoveNext

    Loop

    Set objRange = objExcel.Range("A1")
    objRange.Activate

    Set objRange = objExcel.ActiveCell.EntireColumn
    objRange.Autofit()

    Set objRange = objExcel.Range("B1")
    objRange.Activate
    Set objRange = objExcel.ActiveCell.EntireColumn
    objRange.Autofit()

    Set objRange = objExcel.Range("C1")
    objRange.Activate

    Set objRange = objExcel.ActiveCell.EntireColumn
    objRange.Autofit()

    Set objRange = objExcel.Range("D1")
    objRange.Activate

    Set objRange = objExcel.ActiveCell.EntireColumn
    objRange.Autofit()

    Set objRange = objExcel.Range("A1").SpecialCells(11)
    Set objRange2 = objExcel.Range("C1")
    Set objRange3 = objExcel.Range("A1")


    то что выделено это 25 строка

    • Помечено в качестве ответа Leonid19 26 мая 2009 г. 8:50
    • Снята пометка об ответе Leonid19 27 мая 2009 г. 10:08
  • ооо все работает спасибо большое! это моя оплошность я знак лишний поставил! А еще есть вопросить а как мне сделать так чтобы он выводил пользователей не конкретной категории, а всего домена?
  • укажите следующий путь LDAP:
    LDAP://DC=test,DC=com

    будет искать всех пользователей домена
    mcp, mcdba, mcsa, mcse, ccna
  • Ошибку выдает
    Строка 25
    Ошибка Table does not exist
  • смотрите на синтаксис.. должно быть чтото наподобие:

    "SELECT displayName, memberOf, givenName, sn FROM " _
            & "'LDAP://DC=test,DC=local' WHERE " _
                & "objectCategory='user'" 
    mcp, mcdba, mcsa, mcse, ccna
  • Так и есть все!

  • должно работать.. возможно опять синтаксическая ошибка..
    также убедитесь что LDAP записан заглавными буквами..
    а также что раздел домена в правильном формате.. справа налево.. метки разделены DC..

    также еще приведу пару примеров выгрузки в html

    html:
    wmic.exe /output:d:\users.htm /namespace:\\root\directory\LDAP path ds_user get DS_sn, DS_displayName, DS_memberOf, DS_givenName /format:htable

    csv:
    wmic.exe /output:d:\temp\users.csv /namespace:\\root\directory\LDAP path ds_user get DS_sn, DS_displayName, DS_memberOf, DS_givenName /format:csv

    forma html:
    wmic.exe /output:d:\temp\users.htm /namespace:\\root\directory\LDAP path ds_user get DS_sn, DS_displayName, DS_memberOf, DS_givenName /format:hform


    mcp, mcdba, mcsa, mcse, ccna
  • А вот примеры которые вы привели куда вписывать? Это можно исходя из этого скрипта вывести в HTML таблицу или обязательно нужен новый скрипт?
  • у вас получилось с разделом домена? (все пользователи в домене)

    wmic это утилита командной строки.. тоесть вводите в командной строке эти команды и получаете результат...
    также как и csvde.exe

    p.s.: не забывайте помечать правильные ответы как ответы..
    mcp, mcdba, mcsa, mcse, ccna
  • С доменом не вышло! все вроде правильно!
  • покажите строку запроса которую вы написали.. (весь скрипт ненужен)
    mcp, mcdba, mcsa, mcse, ccna
  •     "SELECT displayName, memberOf, givenName, sn FROM " _
            & "'LDAP://DC=test,DC=local' WHERE " _
                & "objectCategory='user'"
  • хм.. должно работать.. у меня без проблем все проходит..
    mcp, mcdba, mcsa, mcse, ccna
  • Извиняюсь пришлось отлучиться, переписал еще раз тоже самое все работает! Спасибо огромное!!! Кстати я ввел вот эту строчку в командную строку

    wmic.exe /output:d:\users.htm /namespace:\\root\directory\LDAP path ds_user get DS_sn, DS_displayName, DS_memberOf, DS_givenName /format:htable


    и потом пишет дождитесь установки wmic а после этого выдало, что неверный глобальный ключ!!!!

  • Вот есть еще один скрипт который выводит пользователей и группы к которым они относятся! Но необходимо чтобы он показывал данные в HTML таблице!


    On Error Resume Next
    Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
    Set objComputer = GetObject _
        ("
    LDAP://CN=Users,DC=test,DC=local")
     
    ObjComputer.Filter= Array("user")
     
    For Each objUser in objComputer

        WScript.Echo "Fullname: " & objUser.Fullname
        WScript.Echo objUser.cn & " is a member of: "
     
        arrMemberOf = objUser.GetEx("memberOf")
     

        If Err.Number <>  E_ADS_PROPERTY_NOT_FOUND Then
            For Each Group in arrMemberOf
            WScript.Echo vbTab & Group
            Next
        Else
            WScript.Echo vbTab & "Группы не найдены"
            Err.Clear
          End If
        Wscript.Echo VbCrLf
    Next


    Подскжите как это сделать?

  • например так:

    On Error Resume Next
    Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
    
    Dim fsObj, fileObj
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set fileObj = fsObj.CreateTextFile("C:\userlist.htm", True)
    fileObj.WriteLine("<HTML><BODY><TABLE >")
    
    Set objComputer = GetObject _
        ("LDAP://CN=users,DC=test,DC=local")
     
    ObjComputer.Filter= Array("user")
     
    
    dim members_str
    members_str = ""
    
    For Each objUser in objComputer
    
        fileObj.WriteLine("<tr><td>" & objUser.Fullname & "</td>")
        WScript.Echo "Fullname: " & objUser.Fullname
        WScript.Echo objUser.cn & " is a member of: "
     
        arrMemberOf = objUser.GetEx("memberOf")
     
    
        If Err.Number <>  E_ADS_PROPERTY_NOT_FOUND Then
            For Each Group in arrMemberOf
                 members_str = members_str & Group & "</br>"
    	     WScript.Echo vbTab & Group
            Next
        Else
            members_str = "Группы не найдены"
            Err.Clear
          End If
            
        fileObj.WriteLine("<td>" & members_str & "</td></tr>")
        members_str = ""
        Wscript.Echo VbCrLf
    Next
    fileObj.WriteLine("</TABLE></BODY></HTML>")

    mcp, mcdba, mcsa, mcse, ccna
    • Помечено в качестве ответа Leonid19 27 мая 2009 г. 10:59
  • Спасибо огромное!!!!! :)

  • У меня похожая с Леонидом проблема, есть 2 скрипта с помощью которых необходимо вывести заблокированных пользователей и пользователей с временным ограничением к сетевым ресурсам, вот они:
    1)Option Explicit

    Dim objExcel
    Dim objWorkbook

    Dim strHTMLText
    Dim intCounter

    Dim objDomain
    Dim objUser

    Dim dtAccountExpirationDate

    Dim objFSO
    Dim objTS

    Set objExcel = WScript.CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Add


    strHTMLText = "<html><title>Отчет о bla-bla-bla</title><body>"
    strHTMLText = strHTMLText & "<h1>Отчет о bla-bla-bla</h1>"

    objWorkbook.Sheets(1).Cells(1, 1).Value = "Отчет о bla-bla-bla"

    intCounter = 0

    Set objDomain = GetObject("WinNT://********,domain") ' NetBIOS-имя домена
    objDomain.Filter = Array("User")

    On Error Resume Next

    For Each objUser In objDomain
    If Not IsNull(objUser.AccountExpirationDate) Then
    If Err.Number = 0 Then
    WScript.Echo objUser.Name, objUser.AccountExpirationDate
    strHTMLText = strHTMLText & objUser.Name & ":" & objUser.AccountExpirationDate & "<br />"
    objWorkbook.Sheets(1).Cells(intCounter + 3, 1).Value = objUser.Name & ":" & objUser.AccountExpirationDate

    intCounter = intCounter + 1
    Else
    Err.Clear
    End If
    End If
    Next

    On Error Goto 0

    strHTMLText = strHTMLText & "Всего <b>" & intCounter & "</b> bla-bla-bla"
    objWorkbook.Sheets(1).Cells(intCounter + 3 + 1, 1).Value = "Всего " & intCounter & " bla-bla-bla"

    strHTMLText = strHTMLText & "</body></html>"

    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set objTS = objFSO.CreateTextFile("c:\disabled users2.htm", True)

    objTS.Write strHTMLText
    objTS.Close

    Set objTS = Nothing
    Set objFSO = Nothing

    objWorkbook.SaveAs "c:\disabled_users2.xls"
    objExcel.Quit

    Set objDomain = Nothing

    Set objWorkbook = Nothing
    Set objExcel = Nothing

    WScript.Quit 0

    2)Option Explicit

    Const ADS_UF_ACCOUNTDISABLE = 2


    Dim objExcel
    Dim objWorkbook

    Dim objConnection
    Dim objCommand
    Dim objRecordset
    Dim intUAC

    Dim strHTMLText
    Dim intCounter

    Dim objFSO
    Dim objTS

    Set objExcel = WScript.CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Add


    Set objConnection = WScript.CreateObject("ADODB.Connection")
    Set objCommand = WScript.CreateObject("ADODB.Command")

    objConnection.Open "Provider=ADsDSOObject;"
    objCommand.ActiveConnection = objConnection
    objCommand.CommandText = _
    "<GC://dc=******,dc=***>;(objectCategory=User);userAccountControl,distinguishedName;subtree"

    Set objRecordSet = objCommand.Execute

    strHTMLText = "<html><title>Отчет о заблокированных учетных записях</title><body>"
    strHTMLText = strHTMLText & "<h1>Отчет о заблокированных учетных записях</h1>"

    objWorkbook.Sheets(1).Cells(1, 1).Value = "Отчет о заблокированных учетных записях"

    intCounter = 3

    Do Until objRecordset.EOF
    'intUAC = objRecordset.Fields("userAccountControl")

    If objRecordset.Fields("userAccountControl") AND ADS_UF_ACCOUNTDISABLE Then
    strHTMLText = strHTMLText & objRecordset.Fields("distinguishedName") & "<br />"
    objWorkbook.Sheets(1).Cells(intCounter, 1).Value = objRecordset.Fields("distinguishedName")

    intCounter = intCounter + 1
    End If

    objRecordset.MoveNext
    Loop

    strHTMLText = strHTMLText & "Всего <b>" & intCounter & "</b> заблокировано"
    objWorkbook.Sheets(1).Cells(intCounter + 1, 1).Value = "Всего " & intCounter & " заблокировано"

    objConnection.Close

    strHTMLText = strHTMLText & "</body></html>"

    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set objTS = objFSO.CreateTextFile("c:\disabled users.htm", True)

    objTS.Write strHTMLText
    objTS.Close

    Set objTS = Nothing
    Set objFSO = Nothing

    objWorkbook.SaveAs "c:\disabled_users.xls"
    objExcel.Quit

    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing

    Set objWorkbook = Nothing
    Set objExcel = Nothing

    WScript.Quit 0


    В результате должны появиться HTML &amp; Excel таблицы с данными, но без всевозможных OU,DC.


    Помогите пожалуйста!
    • Изменено Sergej 51 25 июня 2009 г. 11:29
    24 июня 2009 г. 5:59