Explorer les répertoires

'Version du 9 février 2005

'Fonction d'exploration des répertoires

'Déclaration des constantes pour la lecture et l'ecriture dans les fichiers
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8

Dim CheminFichierResultat 'Chemin du fichier contenant le résultat
Dim CheminRepertoireAExplorer
Dim NiveauSousArboMax

'On récupère le nom du répertoire dans une variable
CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1)

CheminFichierResultat = CheminScriptActuel & "\" & "ResultatRecherche.txt"
CheminFichierResultat = InputBox("Entrez le chemin du fichier contenant le resultat de la recherce","Chemin du fichier de reponse",CheminFichierResultat)
CheminRepertoireAExplorer = InputBox("Entrez le chemin du répertoire a explorer","Chemin du répertoire",CheminScriptActuel)
NiveauSousArboMax = InputBox("Entrez le niveau max d exploration" & vbCrLf & "Mettez 0 si il n y a pas de limite" & VbCrLf & "Mettez par exemple 1 pour n explorer que le premier niveau de répertoires","Niveau d exploration MAX",0)

'Pour les paramètres, la première valeur numérique doit être mise à 0 par défaut, elle correspond au niveau d'arbo de la racine
'La seconde est le niveau de sous arborescence max. Si il est à 0 il n'y a pas de limites. Si le chiffre est à 2 (par exemple) alors le script n'ira pas au dela du niveau n-2)
Call Explorer(CheminRepertoireAExplorer, CheminFichierResultat,0,0)

Public Sub Explorer(ByVal CheminRepertoireAExplorer, ByVal CheminFichierResultat, ByVal NiveauSousArborescence, NiveauSousArboMax)


	Dim ExplorerSousRep 'A 1 si on doit explorer les sous répertoires
	Dim objFSOExploration 'Objet FSO pour l'accès au système de fichiers
	Dim objFolder 'Représente un répertoire
	Dim objTextFile 'Représente le fichier texte qui contient les réponses

	'Création des objets
	Set objFSOExploration = CreateObject("Scripting.FileSystemObject")

	'On fait un objet qui représente le répertoire à explorer
	Set objFolder = objFSOExploration.GetFolder(CheminRepertoireAExplorer)

	'Pour tous les fichiers du répertoire

	For Each MonFichier In objFolder.Files
		'Exemple d'utilisation, on ecrit le nom des fichiers
		Set objTextFile = objFSOExploration.OpenTextFile(CheminFichierResultat, ForAppending, True)
		objTextFile.WriteLine(NiveauSousArborescence & " ; " & "Fichier ; " & MonFichier.Name & " dans " & CheminRepertoireAExplorer) 'Ecriture du nom du fichier dans le fichier texte
		objTextFile.Close
		Set objTextFile = Nothing
	Next

	ExplorerSousRep = 0 'Par défaut on n'explore pas les sous-répertoires

	'Si on n'a pas de limitation au niveau de l'exploration des sous-répertoires
	If NiveauSousArboMax = 0 Then
		ExplorerSousRep = 1
	End If

	'Si on a une limitation au niveau de l'exploration des sous répertoire

	If (NiveauSousArboMax <> 0) AND (NiveauSousArborescence < NiveauSousArboMax) Then
		ExplorerSousRep = 1
	End IF

	'Pour tous les sous-répertoires
	For Each MonFolder In objFolder.SubFolders

		Wscript.Sleep 1

		'Exemple d'utilisation, on ecrit uniquement le nom des répertoires portant un certain nom
		Position = InStr(1, Lcase(MonFolder.Name), "NomRecherche")
		If Position > 0 Then
			Set objTextFile = objFSOExploration.OpenTextFile(CheminFichierResultat, ForAppending, True)
			objTextFile.WriteLine(NiveauSousArborescence & " ; " & "Dossier ; " & MonFolder.Name & " dans " & CheminRepertoireAExplorer) 'Ecriture du nom du dossier dans le fichier texte
			objTextFile.Close
			Set objTextFile = Nothing
		End If 'If Position > 0 Then


		'Si on doit explorer les sous-répertoires

		If ExplorerSousRep = 1 Then

			'Si le nom du répertoire n'est pas à exclure de la recherche
			If (Lcase(MonFolder.Name) <> "program files") AND (Lcase(MonFolder.Name) <> "system32") AND (Lcase(MonFolder.Name) <> "temporary internet files") Then
				Call Explorer(MonFolder.Path, CheminFichierResultat, NiveauSousArborescence + 1, NiveauSousArboMax) 'J'explore ce sous répertoire
			End If

		End If 'If ExplorerSousRep = 1 Then

	Next 'For Each MonFolder In objFolder.SubFolders

	'Destruction des objets
	Set objFolder = Nothing
	Set objFSOExploration = Nothing

End Sub