RECHERCHE DES INFORMATIONS UTILISATEURS / GROUPES / COMPUTERS DANS ACTIVE DIRECTORY

'---------------------------------------------------------------------------------------------------------
' Search Users / Groups / Computers Information in the current Windows domain
'---------------------------------------------------------------------------------------------------------
set netw=createobject("wscript.network")
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
set oshell = createobject("wscript.shell")
'---------------------------------------------------------------------------------------------------------
' Set the SaveFile
'---------------------------------------------------------------------------------------------------------
SavePathFile = "C:\Save_AD_" & datediff("d",#31/12/2007#,date) & ".csv"
Set OutPutFileTxt = FileSystem.CreateTextFile( SavePathFile, True)
OutPutFileTxt.WriteLine "ItemTyp;ItemName;Member Cat.;DistinguishedName"
'---------------------------------------------------------------------------------------------------------
'Find the current LDAP Name
'---------------------------------------------------------------------------------------------------------
Set oRootDSE = GetObject("LDAP://RootDSE")
Set oShell = WScript.CreateObject("WScript.Shell")
sUserName = oShell.Environment("PROCESS").Item("username")
Const ADS_PROPERTY_CLEAR = 1
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
strDNSDomain = oRootDSE.Get("defaultNamingContext")
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
strUserNTName = Trim(LogonAccount)
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strUserNTName
If Err.Number <> 0 Then
	On Error GoTo 0
	Wscript.Echo "ERROR: Login not found in Active Directory: " & strUserNTName 
Else
	On Error GoTo 0
	strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
	LDAP_Name = "LDAP://" & strUserDN 
End If 
'---------------------------------------------------------------------------------------------------------
' Main Script
'---------------------------------------------------------------------------------------------------------
Set oContainer=GetObject(LDAP_Name)
EnumerateItems oContainer
OpenExcelFile
OutPutFileTxt.close
'---------------------------------------------------------------------------------------------------------
' EXIT
'---------------------------------------------------------------------------------------------------------
WScript.Quit(0) 
'---------------------------------------------------------------------------------------------------------
'Sub "EnumerateItems"
'---------------------------------------------------------------------------------------------------------
	Sub EnumerateItems(oCont)
	Dim oItem
	On Error Resume Next
	For Each oItem In oCont
		Select Case LCase(oItem.Class)
			Case "user"
				strmemberOf = oItem.GetEx("memberOf")
				OutPutFileTxt.WriteLine "User;" & oItem.cn
				For Each Item in strmemberOf
					OutPutFileTxt.WriteLine ";" & oItem.cn & ";IsMemberOf;" & Item
				next
				strmemberof = UNSET
			Case "group"
				OutPutFileTxt.WriteLine "Group;" & oItem.cn
				strhasmember = oItem.GetEx("member")
				For Each Item in strhasmember
					OutPutFileTxt.WriteLine ";" & oItem.cn & ";HasMember;" & Item
				next
				strhasmember = UNSET
				strmemberOf = oItem.GetEx("memberOf")
				For Each Item in strmemberOf
					OutPutFileTxt.WriteLine ";" & oItem.cn & ";IsMemberOf;" & Item
				next
				strmemberof = UNSET
			Case "computer"
				strmemberOf = oItem.GetEx("memberOf")
				OutPutFileTxt.WriteLine "Computer;" & oItem.cn
				For Each Item in strmemberOf
					OutPutFileTxt.WriteLine ";" & oItem.cn & ";IsMemberOf;" & Item
				next
				strmemberof = UNSET
			Case "organizationalunit", "container"
				EnumerateItems oItem
		End Select
	Next
	End Sub

'---------------------------------------------------------------------------------------------------------
'Open .CSV File in Excel with Filter on the First Line
'---------------------------------------------------------------------------------------------------------
Sub OpenExcelFile
	Set objExcel = CreateObject("Excel.Application")
	objExcel.visible = true
	objExcel.Workbooks.Open(SavePathFile)
	objExcel.Range("A1").Select
	objExcel.Selection.AutoFilter
	objExcel.Columns("A:D").Select
	objExcel.Columns("A:D").EntireColumn.AutoFit
	objExcel.Range("A1:D1").Select
	objExcel.Selection.Font.Bold = True
	objExcel.Selection.Interior.ColorIndex = 15
End Sub