AD alle User auslesen

Option Explicit
On Error Resume Next
Const ADS_PROPERTY_UPDATE = 2
const start = 2000

DIM username, ou, n, StrData, j, name, i, jahr, k,l
DIM objUser, objConnection, objCommand
Dim objShell, DataOut, head
DIM strComputer, colItems, objWMIService,objItem
'Array für die Jahre erstellen
DIM yArr()
'Groesse des Arrays festlegen
REDIM yARR(initialize())


Set objShell = CreateObject(WScript.Shell)


'AODB verbindung aufbauen
Set objConnection = CreateObject(ADODB.Connection)
Set objCommand = CreateObject(ADODB.Command)
objConnection.Provider = ADsDSOObject
objConnection.Open Active Directory Provider
Set objCommand.ActiveConnection = objConnection


for l = 0 to UBound(yArr)
	yArr(l) = 0			
next


strComputer = .
Set objWMIService = GetObject(winmgmts:\\ & strComputer & \root\cimv2)
Set colItems = objWMIService.ExecQuery(Select * from Win32_UserAccount)

For Each objItem in colItems

	name = objItem.Name
	ou = getOUByUserName(name)
		if ou =  then
			msgobx(name)
		else
			
				i = 0
					
				Set objUser = GetObject(LDAP://cn= & name & , & ou)
				
				
					If err.number <> 0 then
						msgbox(Error:  & name &   & err.number &  _
						& err.description &   & err.HelpContext &   & err.source)
						
					else
							
						jahr = YEAR(objUser.WhenCreated)
						l = 0
						
						for k = start to year(date)
									
							if k = jahr then
								yArr(l) = yArr(l) + 1
							end if
											
							l = l + 1
						next
				
					end if
					
					i =i+1
				
		end if

next	
		
	

head = User Entwicklung & vbcrlf &vbcrlf & Jahr & vbtab & Anzahl & vbcrlf

l = 0
for k = start to year(date)
	DataOut = DataOut & k & vbtab & yArr(l) & vbcrlf
	l = l + 1
next

msgbox(head & DataOut)

 
'OU des Users ermitteln
function getOUByUserName(byval UserName)

	DIM namingContext, ldapFilter, ou
	DIM cn, cmd, rs
	DIM objRootDSE

	set objRootDSE = getobject(LDAP://RootDSE)
		namingContext = objRootDSE.Get(defaultNamingContext)
	set objRootDSE = nothing

	ldapFilter = <LDAP:// & namingContext & >;(&(objectCategory=User)(name= & userName & )) & ;distinguishedName
	set cn = createobject(ADODB.Connection)
	set cmd = createobject(ADODB.Command)

	cn.open Provider=ADsDSOObject;
	cmd.activeconnection = cn
	cmd.commandtext = ldapFilter
	set rs = cmd.execute

	if rs.eof <> true and rs.bof <> true then
		ou = rs(0)
		ou = mid(ou,instr(ou,,)+1,len(ou)-instr(ou,,))
		getOUByUserName = ou
	end if
	
	rs.close
	cn.close
end function

'Groesse des Arrays ermitteln
function initialize() 

	dim k, ix
	ix = 0
	
	for k = start to year(date)
		ix = ix + 1
	next

	initialize = ix

end function