'---------------------------------------------------------------------------------------------------------
' 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