Generation recursive de sous répertoire

Télécharger le projet
Commenter

Description

Ce programme génère des répertoires à partir du fichier généré par le prog "LISTAGE RECURSIF DE SOUS RÉPERTOIRE" et recrée l'arbo sauvegardé dans celui-ci. La création des repertoires s'effectue à partir de l'endroie où s'execute le programme.

Source / Exemple : 


' genrep.vbs 
' génère dans le répertoire d'où il est lancé les répertoires présent dans le fichier
 ' Ouverture du fichier qui contient la liste
Set objFSO = CreateObject("Scripting.FileSystemObject")
strRepNomFichierLst = ".\repList.txt"
On Error Resume Next
Set objLectureLst = objFSO.OpenTextFile(strRepNomFichierLst, 1) 'for reading
If Err.Number > 0 Then
	If Err.Number = 53 Then '53 : fichier absent
		MsgBox Err.Number  & " : Fichier de génération absent, traitement terminé"
		Wscript.Quit
	End If
End If
On Error GoTo 0

' lecture de la premiere ligne
strRepInit = objLectureLst.ReadLine
Set folderPath = objFSO.GetFolder(".")
Set lstSubfolders = folderPath.SubFolders
Set newfolder = lstSubfolders.Add(strRepInit)
' lancement du programme récursif de génération
Call P_genRep(strRepInit)

MsgBox "Terminé"
Wscript.Quit

' fonction de parcours de rep en récursif
Sub P_genRep(l_szRepInit)
	On Error Resume Next
	' lecture du nouveau rep à créer
	szNewRep = objLectureLst.ReadLine
	If Err.Number = 62 Then  ' si fin du fichier
		Exit sub
	End If
	On Error GoTo 0
	
	If InStr(szNewRep, l_szRepInit) > 0 Then
		' si le nouveau sous-répertoire se trouve dans le rep que l'on vient de créer
		sznewRepInit = l_szRepInit & "\"
	Else
		' sinon on trouve le dénominateur commun pour re descendre l'arbo
		sznewRepInit = F_recupArboMin(l_szRepInit, szNewRep)
	End If
	Set folderPath = objFSO.GetFolder(sznewRepInit)
	Set lstSubfolders = folderPath.SubFolders
	Set newfolder = lstSubfolders.Add(replace(szNewRep, sznewRepInit , ""))
	Call P_genRep(szNewRep)
End Sub

' retourne la partie commune des deux rep
Function F_recupArboMin(l_szRepDebut, l_szNewRep)
	F_recupArboMin = ""
	' si il reste des sous répertoires
	If InStr(l_szRepDebut, "\") > 0 and InStr(l_szNewRep, "\") > 0 Then
		If Left(l_szRepDebut, InStr(l_szRepDebut,"\")-1) = Left(l_szNewRep, InStr(l_szNewRep,"\")-1) Then
			szRepCommun = Left(l_szRepDebut, InStr(l_szRepDebut,"\"))
			newDebut= Mid(l_szRepDebut, Len(szRepCommun)+1)
			newNewRep = Mid(l_szNewRep, Len(szRepCommun)+1)
			' si il reste quelquechose à parcourir
			If Len(newDebut) >1 Then
				F_recupArboMin = szRepCommun & F_recupArboMin(newDebut, newNewRep)
			Else
				F_recupArboMin = szRepCommun
			End If
			Exit Function
		End If
	End If
End Function
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.

Du même auteur (cs_defrance)