Generation recursive de sous répertoire

Soyez le premier à donner votre avis sur cette source.

Vue 4 931 fois - Téléchargée 246 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
12
Date d'inscription
mercredi 4 janvier 2006
Statut
Membre
Dernière intervention
12 janvier 2006

Merci a defrance pour ce pti script compréhensible ^^ qui peut me servir, seulement je voudrais y ajouter la fonction qui permet d'attribuer des droits d'accès aux dossier créés. g donc rajouté ce qui suit:

Dim CommandeDOS
Dim WSHShell
Set WSHShell=WScript.CreateObject("WScript.Shell")

CommandeDOS = "cacls " & ??? & " /p " & ??? & " :r opearchiv:f"
WSHShell.Run(CommandeDOS)

A la place des ??? jveu mettre la variable qui a le nom du dossier mais je ne sais pas lakel c'est.

merci de m'aider
Messages postés
148
Date d'inscription
dimanche 13 octobre 2002
Statut
Membre
Dernière intervention
13 novembre 2008

Totalement d'accord :)
C'était simplement un complement à ton source et surment pas une critique.
Messages postés
24
Date d'inscription
jeudi 6 mars 2003
Statut
Membre
Dernière intervention
20 novembre 2011

Effectivement, c'est plus court mais le but était de jouer qu'avec du vbs simple. de plus va savoir si cette dll est bien présente sur toutes les versions de windows...
De plus le langage que tu donnes c'est du vb pas du vbs.
Messages postés
148
Date d'inscription
dimanche 13 octobre 2002
Statut
Membre
Dernière intervention
13 novembre 2008

Il existe une fontion dans une api qui le fait aussi de mainière très puissante: MakeSureDirectoryPathExists nomfichier
Elle permet de reconstruire l'aroboresence à partir d'un chemin d'accès

Dans le cas de cet article , ca devrait faire ca:

Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Private Sub Form_Load()
Open "c:\\test1.txt" For Input As 1
Do While Not EOF(1)
Line Input #1, chemin
MakeSureDirectoryPathExists chemin
Loop
Close 1
End Sub

Vu sur vb france sur l'article:
http://www.vbfrance.com/code.aspx?ID=4454
Messages postés
148
Date d'inscription
dimanche 13 octobre 2002
Statut
Membre
Dernière intervention
13 novembre 2008

Il existe une fontion dans une api qui le fait aussi de mainière très puissante: MakeSureDirectoryPathExists nomfichier
Elle permet de reconstruire l'aroboresence à partir d'un chemin d'accès

Dans le cas de cet article , ca devrait faire ca:

Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Private Sub Form_Load()
Open "c:\\test1.txt" For Input As 1
Do While Not EOF(1)
Line Input #1, chemin
MakeSureDirectoryPathExists chemin
Loop
Close 1
End Sub

Vu sur vb france sur l'article:
http://www.vbfrance.com/code.aspx?ID=4454

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.