Usuário com melhor resposta
Planilha com dados de usarios

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
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
- Sugerido como Resposta Fábio JrModerator terça-feira, 21 de agosto de 2012 02:04
- Marcado como Resposta Fábio JrModerator quarta-feira, 22 de agosto de 2012 02:25