none
Planilha com dados de usarios RRS feed

  • Pergunta

  • Bem pessoal estou tentando fazer uma planilha com os dados de todos os usuários do AD mais estou encontrando problemas em 1 coisas:

    1 - tenho varias OU tipo este exemplo

    -+Brasil

    |- Cidade_a

    |- Cidade_b

    |- Cidade_c

    Mas quero as informações apenas dos usuários da OU cidade_a para baixo.

    Estou usando este script mais estou encontrando erros teria como alguém me dar um help.

    Sera que estou colando atributos que não exitem ou se existem tem linhas diferentes

    Set objNetwork = CreateObject("WScript.Network")
    Set objExcel = CreateObject("Excel.Application")
    
    objExcel.Visible = True
    objExcel.Workbooks.Add
    intRow = 2
    
    objExcel.Cells(1, 1).Value = "Delivery Office"
    objExcel.Cells(1, 2).Value = "Display name"
    objExcel.Cells(1, 3).Value = "Logon"
    objExcel.Cells(1, 4).Value = "Role"
    objExcel.Cells(1, 5).Value = "Description"
    objExcel.Cells(1, 6).Value = "Department"
    objExcel.Cells(1, 7).Value = "E-mail"
    objExcel.Cells(1, 8).Value = "Expires"
    objExcel.Cells(1, 9).Value = "Last Logon"
    objExcel.Cells(1, 10).Value = "City"
    objExcel.Cells(1, 11).Value = "Company"
    objExcel.Cells(1, 12).Value = "Title"
    objExcel.Cells(1, 13).Value = "When Created"
    objExcel.Cells(1, 14).Value = "When Changed"
    objExcel.Cells(1, 15).Value = "DN"
    objExcel.Cells(1, 16).Value = "Script"
    objExcel.Cells(1, 17).Value = "Member of"
    objExcel.Cells(1, 18).Value = "Pwd last set"
    
    strDomain = InputBox ("Digite o dominio, ex.: dominio.com.br")
    'strDomain = objNetwork.UserDomain
    Set DomObj = GetObject("WinNT://" & strDomain )
    DomObj.Filter = Array("User")
    For Each objUser In DomObj
    
    UserPath = GetUserPath(objUser.Name)
    Set objUserLDAP = getobject(UserPath)
    
    objExcel.Cells(intRow, 1).Value = objUserLDAP.physicalDeliveryOfficeName
    objExcel.Cells(intRow, 2).Value = objUserLDAP.DisplayName
    objExcel.Cells(intRow, 3).Value = objUserLDAP.userprincipalname
    objExcel.Cells(intRow, 4).Value = objUserLDAP.useraccountcontrol
    objExcel.Cells(intRow, 5).Value = objUserLDAP.Description
    objExcel.Cells(intRow, 6).Value = objUserLDAP.department
    objExcel.Cells(intRow, 7).Value = objUserLDAP.mail
    objExcel.Cells(intRow, 8).Value = objUserLDAP.accountexpires
    objExcel.Cells(intRow, 9).Value = objUserLDAP.lastlogon
    objExcel.Cells(intRow, 10).Value = objUserLDAP.l
    objExcel.Cells(intRow, 11).Value = objUserLDAP.company
    objExcel.Cells(intRow, 12).Value = objUserLDAP.title
    objExcel.Cells(intRow, 13).Value = objUserLDAP.whencreated
    objExcel.Cells(intRow, 14).Value = objUserLDAP.whenchanged
    objExcel.Cells(intRow, 15).Value = objUserLDAP.distinguishedname
    objExcel.Cells(intRow, 16).Value = objUserLDAP.scriptpath
    objExcel.Cells(intRow, 17).Value = objUserLDAP.memberof
    objExcel.Cells(intRow, 18).Value = objUserLDAP.pwdlastset
    intRow = intRow + 1
    
    Next
    objExcel.Range("A1:N1").Select
    objExcel.Selection.Interior.ColorIndex = 19
    objExcel.Selection.Font.ColorIndex = 11
    objExcel.Selection.Font.Bold = True
    objExcel.Cells.EntireColumn.AutoFit
     
    MsgBox "lista gerada com sucesso"
    Function getUserPath(byval sUserName)
        set cmd=createobject("ADODB.Command")
        set cn=createobject("ADODB.Connection")
        set rs=createobject("ADODB.Recordset")
       
        cn.open "Provider=ADsDSOObject;"
       
        cmd.commandtext = "SELECT adspath from 'LDAP://" & getnc & _
                  "' WHERE objectCategory = 'User' and sAMAccountName = '" & sUserName & "'"
        cmd.activeconnection = cn
       
        set rs = cmd.execute
       
        if rs.bof <> true and rs.eof<>true then
            getUserPath=rs(0)
        else
            getUserPath = ""
        end if
        cn.close
    
    end function
    
    
    function getNC
        set objRoot=getobject("LDAP://RootDSE")
        getNC=objRoot.get("defaultNamingContext")
    end function

    terça-feira, 14 de agosto de 2012 21:31

Respostas

  • Fernando,

    Tente adaptar este código a sua necessidade:

    Dim ObjWb 
    Dim ObjExcel 
    Dim x, zz 
    Set objRoot = GetObject("LDAP://RootDSE") 
    strDNC = objRoot.Get("DefaultNamingContext") 
    Set objDomain = GetObject("LDAP://" & strDNC) ' Bind to the top of the Domain using LDAP using ROotDSE 
    Call ExcelSetup("Sheet1") ' Sub to make Excel Document 
    x = 1 
    Call enummembers(objDomain) 
    Sub enumMembers(objDomain) 
    On Error Resume Next 
    Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's 
    For Each objMember In objDomain ' go through the collection 
    
    If ObjMember.Class = "user" Then ' if not User object, move on. 
    x = x +1 ' counter used to increment the cells in Excel 
    
    objwb.Cells(x, 1).Value = objMember.Class 
    ' I set AD properties to variables so if needed you could do Null checks or add if/then's to this code 
    ' this was done so the script could be modified easier. 
    SamAccountName = ObjMember.samAccountName 
    Cn = ObjMember.CN 
    FirstName = objMember.GivenName 
    LastName = objMember.sn 
    initials = objMember.initials 
    Descrip = objMember.description 
    Office = objMember.physicalDeliveryOfficeName 
    Telephone = objMember.telephonenumber 
    EmailAddr = objMember.mail 
    Fax = objMember.facsimileTelephoneNumber 
    Addr1 = objMember.streetAddress 
    City = objMember.l 
    State = objMember.st 
    ZipCode = objMember.postalCode 
    Title = ObjMember.Title 
    Department = objMember.Department 
    Company = objMember.Company 
    Manager = ObjMember.Manager 
    Profile = objMember.profilePath 
    LoginScript = objMember.scriptpath 
    HomeDirectory = ObjMember.HomeDirectory 
    HomeDrive = ObjMember.homeDrive 
    AdsPath = Objmember.Adspath 
    LastLogin = objMember.LastLogin 
    
    zz = 1 ' Counter for array of 2ndary email addresses 
    For each email in ObjMember.proxyAddresses 
    If Left (email,5) = "SMTP:" Then 
    Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary 
    ElseIf Left (email,5) = "smtp:" Then 
    Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP emails into Array. 
    zz = zz + 1 
    End If 
    Next 
    ' Write the values to Excel, using the X counter to increment the rows. 
    
    objwb.Cells(x, 2).Value = SamAccountName 
    objwb.Cells(x, 3).Value = CN 
    objwb.Cells(x, 4).Value = FirstName 
    objwb.Cells(x, 5).Value = LastName 
    objwb.Cells(x, 6).Value = Initials 
    objwb.Cells(x, 7).Value = Descrip 
    objwb.Cells(x, 8).Value = Office 
    objwb.Cells(x, 9).Value = Telephone 
    objwb.Cells(x, 10).Value = EmailAddr
    objwb.Cells(x, 11).Value = Fax 
    objwb.Cells(x, 12).Value = Addr1 
    objwb.Cells(x, 13).Value = City 
    objwb.Cells(x, 14).Value = State 
    objwb.Cells(x, 15).Value = ZipCode 
    objwb.Cells(x, 16).Value = Title 
    objwb.Cells(x, 17).Value = Department 
    objwb.Cells(x, 18).Value = Company 
    objwb.Cells(x, 19).Value = Manager 
    objwb.Cells(x, 20).Value = Profile 
    objwb.Cells(x, 21).Value = LoginScript 
    objwb.Cells(x, 22).Value = HomeDirectory 
    objwb.Cells(x, 23).Value = HomeDrive 
    objwb.Cells(x, 24).Value = Adspath 
    objwb.Cells(x, 25).Value = LastLogin 
    objwb.Cells(x,26).Value = Primary 
    
    ' Write out the Array for the 2ndary email addresses. 
    For ll = 1 To 20 
    objwb.Cells(x,26+ll).Value = Secondary(ll) 
    Next 
    ' Blank out Variables in case the next object doesn't have a value for the property 
    SamAccountName = "-" 
    Cn = "-" 
    FirstName = "-" 
    LastName = "-" 
    initials = "-" 
    Descrip = "-" 
    Office = "-" 
    Telephone = "-" 
    EmailAddr = "-" 
    Fax = "-" 
    Addr1 = "-" 
    City = "-" 
    State = "-" 
    ZipCode = "-" 
    Title = "-" 
    Department = "-" 
    Company = "-" 
    Manager = "-" 
    Profile = "-" 
    LoginScript = "-" 
    HomeDirectory = "-" 
    HomeDrive = "-" 
    Primary = "-" 
    For ll = 1 To 20 
    Secondary(ll) = "" 
    Next 
    End If 
    
    ' If the AD enumeration runs into an OU object, call the Sub again to itinerate 
    
    If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then 
    enumMembers (objMember) 
    End If 
    Next 
    End Sub 
    Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row 
    Set objExcel = CreateObject("Excel.Application") 
    Set objwb = objExcel.Workbooks.Add 
    Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName) 
    Objwb.Name = "Active Directory Users" ' name the sheet 
    objwb.Activate 
    objExcel.Visible = True 
    objwb.Cells(1, 2).Value = "SamAccountName" 
    objwb.Cells(1, 3).Value = "CN" 
    objwb.Cells(1, 4).Value = "FirstName" 
    objwb.Cells(1, 5).Value = "LastName" 
    objwb.Cells(1, 6).Value = "Initials" 
    objwb.Cells(1, 7).Value = "Descrip" 
    objwb.Cells(1, 8).Value = "Office" 
    objwb.Cells(1, 9).Value = "Telephone" 
    objwb.Cells(1, 10).Value = "Email" 
    objwb.Cells(1, 11).Value = "Fax" 
    objwb.Cells(1, 12).Value = "Addr1" 
    objwb.Cells(1, 13).Value = "City" 
    objwb.Cells(1, 14).Value = "State" 
    objwb.Cells(1, 15).Value = "ZipCode" 
    objwb.Cells(1, 16).Value = "Title" 
    objwb.Cells(1, 17).Value = "Department" 
    objwb.Cells(1, 18).Value = "Company" 
    objwb.Cells(1, 19).Value = "Manager" 
    objwb.Cells(1, 20).Value = "Profile" 
    objwb.Cells(1, 21).Value = "LoginScript" 
    objwb.Cells(1, 22).Value = "HomeDirectory" 
    objwb.Cells(1, 23).Value = "HomeDrive" 
    objwb.Cells(1, 24).Value = "Adspath" 
    objwb.Cells(1, 25).Value = "LastLogin" 
    objwb.Cells(1, 26).Value = "Primary SMTP" 
    End Sub 
    MsgBox "Done" ' show that script is complete

    Atente para a linha:

    Set objDomain = GetObject("LDAP://" & strDNC)

    Neste caso ela está pegando todo o dominio, altere para o caminho LDAP da sua OU.Exemplo:

    Set objDomain = GetObject("LDAP://OU=cidade_a,ou=brasil,dc=seu,dc=dominio,dc=br")

    E também os campos exportados não correspondem aos seu mas basta vc fazer algumas alterações.

    Retirei este script de:

    Export AD users to Excel 

    community.spiceworks.com/scripts/show/402-export-ad-users-to-excel


    Fábio de Paula Junior

    quinta-feira, 16 de agosto de 2012 22:02
    Moderador