Listando Usuários do AD no Excel por vbscript | Kerberos Tech

Hoje irei postar um vbscript para listar todos usuários do Active Directory em uma planilha Excel.

A unica modificação que precisa ser feita é alterar Nome do Domínio para o nome do domínio de sua empresa.

Neste vbscript listaremos, Usuario de Rede, Nome Completo, Descrição, Email, Departamento, Compania e Conta desativada?

Para executa-lo copie o código abaixo, cole no bloco de notas e salve como .vbs.
______________________________________________________________________________

Set objNetwork = CreateObject("WScript.Network")
 Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True
 objExcel.Workbooks.Add
 intRow = 2

 objExcel.Cells(1, 1).Value = "Usuario de rede"
 objExcel.Cells(1, 2).Value = "Nome Completo"
 objExcel.Cells(1, 3).Value = "Descrição"
 objExcel.Cells(1, 4).Value = "Email"
 objExcel.Cells(1, 5).Value = "Departamento"
 objExcel.Cells(1, 6).Value = "Compania"
 objExcel.Cells(1, 7).Value = "Conta Desabilitada?"

'strDomain = InputBox ("Nome do Dominio")
 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.sAMAccountName

     objExcel.Cells(intRow, 2).Value = objUserLDAP.DisplayName

     objExcel.Cells(intRow, 3).Value = objUserLDAP.Description

     objExcel.Cells(intRow, 4).Value = objUserLDAP.mail
     objExcel.Cells(intRow, 5).Value = objUserLDAP.Department

     objExcel.Cells(intRow, 6).Value = objUserLDAP.Company
     objExcel.Cells(intRow, 7).Value = objUserLDAP.AccountDisabled

     intRow = intRow + 1

Next

objExcel.Range("A1:G1").Select
 objExcel.Selection.Interior.ColorIndex = 19
 objExcel.Selection.Font.ColorIndex = 11
 objExcel.Selection.Font.Bold = True
 objExcel.Cells.EntireColumn.AutoFit

 MsgBox "Concluído"

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