' -------------------------------------------------------------------------
'       From the book Inside Active Directory, ISBN 0-201-61621-1
'       Copyright (C) 2002 by Addison-Wesley
'       Script by Sakari Kouti (see http://www.kouti.com)
' You have a royalty-free right to use, modify, reproduce and distribute
' this script (and/or any modified version) in any way you find useful,
' provided that you agree that Addison-Wesley or Sakari Kouti has no
' warranty, obligations or liability for the script. If you modify
' the script, you must retain this copyright notice.
' -------------------------------------------------------------------------
Option Explicit

Dim objExcel, objDSE, objSchema, objChild, i, varValue
Dim arrParamList(18)

'Names and Identifiers
arrParamList(0) = "lDAPDisplayName"
arrParamList(1) = "cn"
arrParamList(2) = "adminDisplayName"
arrParamList(3) = "distinguishedName"
arrParamList(4) = "adminDescription"
arrParamList(5) = "attributeID"
arrParamList(6) = "mAPIID"
arrParamList(7) = "linkID"
'Syntax and Content Rules
arrParamList(8) = "attributeSyntax"
arrParamList(9) = "oMSyntax"
arrParamList(10) = "isSingleValued"
arrParamList(11) = "rangeLower"
arrParamList(12) = "rangeUpper"
arrParamList(13) = "extendedCharsAllowed"
'Searches
arrParamList(14) = "searchFlags"
arrParamList(15) = "isMemberofPartialAttributeSet"
'Miscellaneous
arrParamList(16) = "systemOnly"
arrParamList(17) = "systemFlags"
arrParamList(18) = "objectCategory"

Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.ActiveSheet.Name = "attributeSchema objects"

objExcel.ActiveSheet.Range("A1").Activate
For i = LBound(arrParamList) To UBound(arrParamList)
	objExcel.ActiveCell.Offset(0,i).Value = arrParamList(i)
Next
objExcel.ActiveCell.Offset(1,0).Activate	'Move to next line

Set objDSE = GetObject("LDAP://rootDSE")
Set objSchema = GetObject("LDAP://" & _
	objDSE.Get("schemaNamingContext"))

On Error Resume Next
For Each objChild In objSchema
	If objChild.Class = "attributeSchema" Then
		For i = LBound(arrParamList) To UBound(arrParamList)
			varValue = objChild.Get(arrParamList(i))
			If Err <> 0 Then	'property not found or some other error
				Err.Clear
				varValue = ""
			End If
			objExcel.ActiveCell.Offset(0,i).Value = varValue
		Next
		objExcel.ActiveCell.Offset(1,0).Activate	'Move to next line
	End If
Next