Extract active directory et trie automatique

Télécharger le projet
Commenter

Description

Bonjour, C'est mon premier script sur le site.

Je sais qu? il existe des Outils pour faire quelque chose de similaire mais je voulais faire quelque chose a ma sauce avec des spécificité et puis l? exercice est toujours sympa à réaliser.

Le but de ce script est : D'extraire sur tout un domaine les utilisateurs avec certain attributs LDAP et ensuite les trier automatiquement dans un fichier Excel.

De base l'ensemble des fichiers doit être extrait dans C:\temp (Ligne 4 du script)

Ce script permet de vérifier tout les Domain Controller, les Last logon des utilisateurs (Il faut alimenter le fichier DomainController.txt).
Ce script permet aussi d'extraire des utilisateurs suivant des OU specifique (il faut alimenter le fichier Entree-ou.txt)
Ce script permet aussi d'extraire des utilisateurs spécifique (il faut alimenter le fichier Entree.txt)

J? espère qu?il est suffisamment commenté pour vous permettre de l ?utiliser. Je pense que mon script n'est pas le mieux et il faudrait peut être l'améliorer, je reste donc attentif au commentaire

Merci

PS : J'ai fait exactement le meme script mais pour les Ordinateurs

Source / Exemple : 


' ------ A MODIFIER SI VOUS SOUHAITEZ------
' ------ Attention le répertoire doit ------
' ------ exister dans tout les cas------
reptemp="c:\temp\"

' ------ Attention à modifier ------
' ------le nom LDAP du domaine a extraire------
strDomainDN ="dc=FR,dc=ms,dc=Fabrik,dc=com"
strDomainDNOU ="dc=FR,dc=ms,dc=Fabrik,dc=com"

'Declaration des variables
Dim objConnection, objRecords, objExcel, i, objSpread, classeur, feuille, nomfeuil, choixOU, strDC, Date1, Date2
Dim disabled, Memberof, Chainegrp, SplitVir, SplitEgal, Groupe, fso, MyFile, reptemp, filetext, choixcpt, OU, veriflast
bullet = Chr(10) & "   " & Chr(149) & " "
Const Pour_Lire = 1

'Connexion AD
set objConn = CreateObject("ADODB.Connection")
set objCmd = Createobject("ADODB.Command")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"

'Attention le fichier C:\sources.xls doit exister
strSheet = reptemp & "Source.xls"

' Choix du nom du fichier temp a  creer
Filetext=Inputbox("Indiquez le nom du fichier : ")

' création d'un fichier txt pour la première partie du script
Set objFSO = CreateObject("Scripting.FileSystemObject")
set MyFile = objFSO.CreateTextFile(reptemp + filetext + ".txt")
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)

' ------ Que souhaitez vous extraire------
' ------ Le fichier Entree.txt doit contenir le sAMAccountName des utilisateurs a extraire, un code par ligne dans le fichier------
' ------ Le fichier Entree-OU.txt doit contenir le chemin des OU demandés, un chemin par lignes dans le fichier.------
' ------ Exemple : OU=Utilisateurs pour une OU situé dans l'arborescence principale------
' ------ Exemple : OU=VIP,OU=Utilisateurs pour extraire les utilisateurs de l'OU VIP qui est elle même contenu dans l'OU principale Utilisateurs------
choixobj=Inputbox("Vous souhaitez extraire des Utilisateurs:"& Chr(10) & bullet & "1.) Du domaine entier" & bullet & "2.) Contenu dans un fichier User (entree.txt)" & bullet & "3.) Contenu dans un fichier OU (Entree-OU.txt)")

' Maintenant avec le fichier txt je récupère les informations utilisateurs par utilisateurs
on error resume next

if choixobj=1 then
	' Ici un filtre sur les utilisateurs et je récupére leur Distinguishedname
	strBase   =  "<LDAP://" & strDomainDN & ">;"
	strAttrs  = "distinguishedname;"
	strScope  = "subtree"
	strFilter = "(&(objectclass=user)(objectcategory=person));" 

	'Ici lancement de la requete avec les propriété qu'on souhaite
	objTest = strBase & strFilter & strAttrs & strScope
	objCmd.ActiveConnection = objConn
	objCmd.Properties("SearchScope") = 2 
	objCmd.Properties("Page Size") = 32000
	objCmd.CommandText = objTest
	Set objRs = objCmd.Execute
	
	' Ici écriture dans le fichier txt dans le c:\temp
	objRS.MoveFirst
	while Not objRS.EOF
		MyFile.WriteLine (objRS.Fields(0).Value)
		objRS.MoveNext
	wend
	MyFile.close
	
	'Ouverture du fichier Reptemp
	Set UserListe = objFSO.OpenTextFile(reptemp + Filetext + ".txt")
			i=2
	'Lecture du fichier Retemp et extract des informations via la commande Getobject
	Do Until UserListe.AtEndofStream
		strCharacters = UserListe.Readline
		Set objUser = GetObject("LDAP://" & strCharacters)
		OuStr = Right(strCharacters, len(strCharacters) - Instr (strCharacters, ","))
			objExcel.ActiveSheet.Range("A" & 1) = "CN"
			objExcel.ActiveSheet.Range("B" & 1) = "Prenom"
			objExcel.ActiveSheet.Range("C" & 1) = "Nom"
			objExcel.ActiveSheet.Range("D" & 1) = "DisplayName"	
			objExcel.ActiveSheet.Range("E" & 1) = "Description"
			objExcel.ActiveSheet.Range("F" & 1) = "Emplacement"
			objExcel.ActiveSheet.Range("G" & 1) = "Etat du compte"
			objExcel.ActiveSheet.Range("H" & 1) = "Groupes"
			objExcel.ActiveSheet.Range("I" & 1) = "Dernière modification"
			objExcel.ActiveSheet.Range("j" & 1) = "last logon"
			objExcel.ActiveSheet.Range("A" & i).Value = objUser.sAMAccountName
			objExcel.ActiveSheet.Range("B" & i).Value = objUser.givenName
			objExcel.ActiveSheet.Range("C" & i).Value = objUser.sn
			objExcel.ActiveSheet.Range("D" & i).Value = objUser.displayName	
			objExcel.ActiveSheet.Range("E" & i).Value = objUser.Description
			objExcel.ActiveSheet.Range("F" & i).Value = OuStr
			if objUser.lastlogin = "" then
				objExcel.ActiveSheet.Range("j" & i).Value = "01/01/1900 01:00"
				else
				objExcel.ActiveSheet.Range("j" & i).Value = objUser.lastlogin
			end if
			' Verifie si le compte est actif'	
			Disabled = objUser.AccountDisabled
				if (disabled = TRUE) then
					objExcel.ActiveSheet.Range("G" & i).Value = "Disabled"
					Else
					objExcel.ActiveSheet.Range("G" & i).Value = "Enabled"
				End If
		'Extrait les groupes de l'utilisateur
		Memberof = objUser.memberOf
		For Each strGroup In Memberof ' <==== Can Raise an Error
			Chainegrp = strGroup
			SplitVir = Split(Chainegrp,",")
			SplitEgal = Split(Splitvir(0),"=")
				if SplitEgal(1) = "Domain Users" then 
					else
					Groupe = SplitEgal(1) & ", " & Groupe
				End if
		Next
				objExcel.ActiveSheet.Range("H" & i).Value = Groupe
				objExcel.ActiveSheet.Range("I" & i).Value = objUser.WhenChanged		
	'Reinitialisation des variable
	Groupe = ""
	Memberof = ""
	strGroup = ""
	SplitVir = ""
	SplitEgal = ""
		i = i + 1
	Loop
else
End if

if choixobj=2 then
	'Ouverture du fichier d'entrée et temp
	Fichier_S = reptemp & "Entree.txt"
	Set Fichier = objFSO.OpenTextFile (Fichier_S, Pour_Lire, True)
		Do While Fichier.AtEndOfStream <> True
			'Lecture du fichier entree pour lire chaque groupe
			nomfeuil = Fichier.ReadLine
			strFilter = "(&(&(objectclass=user)(objectcategory=person)(samaccountname=" +nomfeuil + "*)));" 
			
			' Ici un filtre sur les utilisateurs et je récupére leur Distinguishedname
			strBase   =  "<LDAP://" & strDomainDN & ">;"
			strAttrs  = "distinguishedname;"
			strScope  = "subtree"
			
			'Ici lancement de la requete avec les propriété qu'on souhaite
			objTest = strBase & strFilter & strAttrs & strScope
			objCmd.ActiveConnection = objConn
			objCmd.Properties("SearchScope") = 2 
			objCmd.Properties("Page Size") = 32000
			objCmd.CommandText = objTest
			Set objRs = objCmd.Execute

			' Ici écriture dans le fichier txt dans le c:\temp
			z=0
			MyFile.WriteLine (objRS.Fields(z).Value)
			z=z+1
		loop
		MyFile.close
		Fichier.close
		Set UserListe = objFSO.OpenTextFile(reptemp + Filetext + ".txt")
	i = 2
	'Lecture du fichier Retemp et extract des informations via la commande Getobject
		Do While UserListe.AtEndOfStream <> True
			strCharacters = UserListe.Readline
			Set objUser = GetObject("LDAP://" & strCharacters)
			OuStr = Right(strCharacters, len(strCharacters) - Instr (strCharacters, ","))
				objExcel.ActiveSheet.Range("A" & 1) = "CN"
				objExcel.ActiveSheet.Range("B" & 1) = "Prenom"
				objExcel.ActiveSheet.Range("C" & 1) = "Nom"
				objExcel.ActiveSheet.Range("D" & 1) = "DisplayName"	
				objExcel.ActiveSheet.Range("E" & 1) = "Description"
				objExcel.ActiveSheet.Range("F" & 1) = "Emplacement"
				objExcel.ActiveSheet.Range("G" & 1) = "Etat du compte"
				objExcel.ActiveSheet.Range("H" & 1) = "Groupes"
				objExcel.ActiveSheet.Range("I" & 1) = "Dernière modification"
				objExcel.ActiveSheet.Range("j" & 1) = "last logon"
				objExcel.ActiveSheet.Range("A" & i).Value = objUser.sAMAccountName
				objExcel.ActiveSheet.Range("B" & i).Value = objUser.givenName
				objExcel.ActiveSheet.Range("C" & i).Value = objUser.sn
				objExcel.ActiveSheet.Range("D" & i).Value = objUser.displayName	
				objExcel.ActiveSheet.Range("E" & i).Value = objUser.Description
				objExcel.ActiveSheet.Range("F" & i).Value = OuStr
				if objUser.lastlogin = "" then
					objExcel.ActiveSheet.Range("j" & i).Value = "01/01/1900 01:00"
					else
					objExcel.ActiveSheet.Range("j" & i).Value = objUser.lastlogin
				end if
				' Verifie si le compte est actif'	
				Disabled = objUser.AccountDisabled	
				if (disabled = TRUE) then
				objExcel.ActiveSheet.Range("G" & i).Value = "Disabled"
					Else
				objExcel.ActiveSheet.Range("G" & i).Value = "Enabled"
				End If
			'Extrait les groupes de l'utilisateur
			Memberof = objUser.memberOf
			For Each strGroup In Memberof ' <==== Can Raise an Error
				Chainegrp = strGroup
				SplitVir = Split(Chainegrp,",")
				SplitEgal = Split(Splitvir(0),"=")
				if SplitEgal(1) = "Domain Users" then 
					else
					Groupe = SplitEgal(1) & ", " & Groupe
				End if
			Next
			objExcel.ActiveSheet.Range("H" & i).Value = Groupe
			objExcel.ActiveSheet.Range("I" & i).Value = objUser.WhenChanged		
		'Reinitialisation des variables
		Groupe = ""
		Chainegrp = ""
		Memberof = ""
		strGroup = ""
		SplitVir = ""
		SplitEgal = ""
		i = i + 1
	Loop
else
end if

if choixobj=3 then
		'Si vous avez choisi depuis un fichier. Compte le nombre de lignes
		Fichier_S = reptemp & "Entree-OU.txt"
		Set Fichier = objFSO.OpenTextFile (Fichier_S, Pour_Lire, True)
		Nbr = 1
	Do While Fichier.AtEndOfStream <> True
		Fichier.ReadLine
		Nbr = Nbr + 1
	Loop
		Fichier.Close
		Set feuille = objExcel.ActiveSheet
		
		'Si il y as plus de trois lignes au fichier entree
	if nbr > 3 then
		For i = 4 To Nbr-1
			'Ajoute une feuille par ligne
			Set oSh = objExcel.Worksheets.Add
			oSh.Name = "Feuil" & i 
		Next
	else
	end if
	i=1
	'Renomme l'ensemble des feuilles
	Set Fichier = objFSO.OpenTextFile (Fichier_S, Pour_Lire, True)
		Do While Fichier.AtEndOfStream <> True
			nomfeuil = Fichier.ReadLine
			objExcel.Worksheets("Feuil" & i).Activate
			objExcel.ActiveSheet.Name = Left(nomfeuil,31) 
			i=i+1
		Loop
	Fichier.Close
			Set oSh = Nothing ' libération mémoire...
			Set Fichier = objFSO.OpenTextFile (Fichier_S, Pour_Lire, True)
	'Lecture du fichier des OU et extract des informations via la commande Getobject			
	Do while (Fichier.AtEndOfStream <> True)
			'Commencement de lecriture ligne 2
			i=2
			nomfeuil = Fichier.ReadLine
			objExcel.Worksheets(Left(nomfeuil,31)).Activate
			strCharacters = nomfeuil +","+ strDomainDNOU
			Set objUser = GetObject("LDAP://" & strCharacters)
			objUser.Filter = Array("user")
		For each objMember in objUser ' get all the members'
			objExcel.ActiveSheet.Range("A" & 1) = "CN"
			objExcel.ActiveSheet.Range("B" & 1) = "Prenom"
			objExcel.ActiveSheet.Range("C" & 1) = "Nom"
			objExcel.ActiveSheet.Range("D" & 1) = "DisplayName"	
			objExcel.ActiveSheet.Range("E" & 1) = "Description"
			objExcel.ActiveSheet.Range("F" & 1) = "Emplacement"
			objExcel.ActiveSheet.Range("G" & 1) = "Etat du compte"
			objExcel.ActiveSheet.Range("H" & 1) = "Groupes"
			objExcel.ActiveSheet.Range("I" & 1) = "Dernière modification"
			objExcel.ActiveSheet.Range("j" & 1) = "last logon"
			objExcel.ActiveSheet.Range("A" & i).Value = objMember.sAMAccountName
			objExcel.ActiveSheet.Range("B" & i).Value = objMember.givenName
			objExcel.ActiveSheet.Range("C" & i).Value = objMember.sn
			objExcel.ActiveSheet.Range("D" & i).Value = objMember.displayName	
			objExcel.ActiveSheet.Range("E" & i).Value = objMember.Description
			objExcel.ActiveSheet.Range("F" & i).Value = strCharacters
			if objMember.lastlogin = "" then
				objExcel.ActiveSheet.Range("j" & i).Value = "01/01/1900 01:00"
				else
				objExcel.ActiveSheet.Range("j" & i).Value = objMember.lastlogin
			end if
			' Verifie si le compte est actif'	
			Disabled = objMember.AccountDisabled
				if (disabled = TRUE) then
					objExcel.ActiveSheet.Range("G" & i).Value = "Disabled"
					Else
					objExcel.ActiveSheet.Range("G" & i).Value = "Enabled"
				End If
			'Extrait les groupes de l'utilisateur
			Memberof = objMember.memberOf
			For Each strGroup In Memberof ' <==== Can Raise an Error
				Chainegrp = strGroup
				SplitVir = Split(Chainegrp,",")
				SplitEgal = Split(Splitvir(0),"=")
				if SplitEgal(1) = "Domain Users" then 
					else
					Groupe = SplitEgal(1) & ", " & Groupe
				End if
			Next
				objExcel.ActiveSheet.Range("H" & i).Value = Groupe
				objExcel.ActiveSheet.Range("I" & i).Value = objMember.WhenChanged
			'Reinitialisation des variables
			Groupe = ""
			Memberof = ""
			strGroup = ""
			SplitVir = ""
			SplitEgal = ""
			i = i + 1
		Next
		
	Loop
else
End if

MyFile.close

'Verifie sur tout les controlleur de domaines les last logon
If ((choixobj=1) or (choixobj=2)) Then
	'Ouverture du fichier Reptemp et DC
	Set DCListe = objFSO.OpenTextFile("DomainController.Txt")
	'Lecture du fichier DC
	Do while (DCListe.AtEndOfStream <> True)
		strDC = DCListe.Readline
		i=2
		Set UserListe = objFSO.OpenTextFile(reptemp + Filetext + ".txt")
		'Lecture du fichier contenant les informations utilisateurs
		Do while (UserListe.AtEndOfStream <> True)
			strCharacters = UserListe.Readline
			Set objUser = GetObject("LDAP://" & strDC & "/" & strCharacters)
				Date1 = objExcel.ActiveSheet.Range("j" & i).Value
				Date2 = objUser.lastlogin
				If DateValue(Date1) >  DateValue(Date2) Then				
				else
					objExcel.ActiveSheet.Range("j" & i)  = objUser.lastlogin
				End if
			objUser = ""
			i = i + 1
		Loop
	Loop
	else
		Fichier.Close
		Set Fichier = objFSO.OpenTextFile (Fichier_S, Pour_Lire, True)
		Set DCListe = objFSO.OpenTextFile("DomainController.Txt")
		Do while (Fichier.AtEndOfStream <> True)
			'Commencement de lecriture ligne 2
			nomfeuil = Fichier.ReadLine
			objExcel.Worksheets(Left(nomfeuil,31)).Activate
			strCharacters = nomfeuil +","+ strDomainDNOU
			Do while (DCListe.AtEndOfStream <> True)
				strDC = DCListe.Readline
				i=2
				Do until  (objExcel.ActiveSheet.Range("A" & i) = "")
					veriflast = objExcel.ActiveSheet.Range("A" & i).Value	
					Set objUser = GetObject("LDAP://" & strDC & "/CN=" & veriflast & "," & strCharacters)
					Date1 = objExcel.ActiveSheet.Range("j" & i).Value
					Date2 = objUser.lastlogin
					If DateValue(Date1) >  DateValue(Date2) Then				
					else
						objExcel.ActiveSheet.Range("j" & i)  = objUser.lastlogin
					End if
					objUser = ""
					i = i + 1
				loop
			loop
		Loop	
End if

'Sauvegarde du fichier Excel
objExcel.ActiveWorkbook.SaveAs(reptemp + Filetext + ".xls")
objExcel.ActiveWorkbook.Close
objExcel.Workbooks.Close

msgbox "Recupération effectuée. Le fichiers excel est dans " + reptemp + Filetext + ".xls"
objExcel.Quit
set objExcel = Nothing
Set oSh = Nothing ' libération mémoire...

Conclusion :


Merci de me faire part de vos impressions sur les éventuels modifications à apportés
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.