Affichage de l'arborescence d'un répertoire
Franko
-
noyon -
noyon -
J'essaie de coder une recherche qui me permettrait d'afficher tous les sous-répertoires d'un répertoire.
voila mon code
Sub initiate(thePath As String)
Dim MyName As String
' Display the names in C:\ that represent directories.
MyName = Dir(thePath & "\", vbDirectory)
While MyName <> "" ' Start the loop.
If MyName <> "." And MyName <> ".." Then
If (GetAttr(thePath & "\" & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
Call initiate(thePath & "\" & MyName, "")
Else
Debug.Print MyName
End If
End If
MyName = Dir ' Get next entry.
Wend
End Sub
Une fonction récursive.
Tout va bien, elle parcoure le contenu du répertoire, et dès qu'un sous-répertoire est détecté, elle se rappelle avec ce sous-répertoire. Le problème, au retour des appels récursifs, la fonction Dir me donne des mots de tête. Elle ne considère pas la logique de la fonction.
Idées???
Merci milles fois
voila mon code
Sub initiate(thePath As String)
Dim MyName As String
' Display the names in C:\ that represent directories.
MyName = Dir(thePath & "\", vbDirectory)
While MyName <> "" ' Start the loop.
If MyName <> "." And MyName <> ".." Then
If (GetAttr(thePath & "\" & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Display entry only if it
Call initiate(thePath & "\" & MyName, "")
Else
Debug.Print MyName
End If
End If
MyName = Dir ' Get next entry.
Wend
End Sub
Une fonction récursive.
Tout va bien, elle parcoure le contenu du répertoire, et dès qu'un sous-répertoire est détecté, elle se rappelle avec ce sous-répertoire. Le problème, au retour des appels récursifs, la fonction Dir me donne des mots de tête. Elle ne considère pas la logique de la fonction.
Idées???
Merci milles fois
A voir également:
- Affichage de l'arborescence d'un répertoire
- Affichage double ecran - Guide
- Windows 11 affichage classique - Guide
- Répertoire téléphonique gratuit - Télécharger - Bureautique
- Pourquoi certains contacts disparaissent de mon répertoire - Accueil - Guide Android
- Problème affichage page internet google chrome ✓ - Forum Google Chrome
2 réponses
Cest un script pour effacer les fichiers/dossiers datant de + de 15 jours, sa poura peut etre t'aider
[code]
'on error resume next
'declaration des variables
Dim folder
dim Subfolder
dim path
Dim FSO
Dim B
'instantation du file system object (FSO)
Set FSO = CreateObject("Scripting.FileSystemObject")
'initialisation de la variable contenant le chemin du repertoire racine
path = "D:\test_transit\Transit"
'appel de la fonction recurcive avec comme argument le chemin du repertoire
'racine
recurcive path
function recurcive(chemin) 'fonction récurcive pour traiter tout l'arboresence
'des dossiers
set folder = FSO.GetFolder (chemin) 'utilisation du FSO pour prendre le dossier
'racine
set Subfolder = folder.SubFolders 'definition de la varibale pour les S/dossiers
for each A in Subfolder 'pour chaque dossier dans le sous dossier racine
Set fic = A.Files 'definition de la variables toucher les fichier des dossier
fichier fic 'appel de la fontion fixhier
recurcive A 're-appel de la fonction recurcive pour traiter les S/dossiers
'dossier path
next
end function 'fin de la fonction
function fichier(fic) 'fonction qui traite les fichiers dans les dossiers A
For Each objFile in fic 'pour chaque fichier dans dossiers de fichier
Set f = fso.GetFile(objfile) 'utilisation du FSO pour prendre le fichier
If DateDiff("D", objfile.DateLastModified, now) > 10 Then 'si la derniére modification du fichier est plus ancienne que X jours
'msgbox objfile & " a suprimer" 'alors effacer le fichier avec option de forcer pour les fichier en lecture seule
FSO.DeleteFile f, force = yes
end if 'fin du SI
next
end function 'fin de la fonction
'function dossier(path) 'fonction pour supprimer les dossier vides (taille = 0 )
set folder = FSO.GetFolder (path)'utilisation du FSO pour prendre le dossier
For Each B in folder.subfolders 'pour chaque dossier dans le dossier racine
If B.size = 0 Then 'si la taille du dossier est egal a 0 (donc vide)
'msgbox B & B.size 'effacer le dossier
FSO.DeleteFolder B, force = yes
End If 'fin du SI
Next
'end function 'fin de la fonction
[/code]
[code]
'on error resume next
'declaration des variables
Dim folder
dim Subfolder
dim path
Dim FSO
Dim B
'instantation du file system object (FSO)
Set FSO = CreateObject("Scripting.FileSystemObject")
'initialisation de la variable contenant le chemin du repertoire racine
path = "D:\test_transit\Transit"
'appel de la fonction recurcive avec comme argument le chemin du repertoire
'racine
recurcive path
function recurcive(chemin) 'fonction récurcive pour traiter tout l'arboresence
'des dossiers
set folder = FSO.GetFolder (chemin) 'utilisation du FSO pour prendre le dossier
'racine
set Subfolder = folder.SubFolders 'definition de la varibale pour les S/dossiers
for each A in Subfolder 'pour chaque dossier dans le sous dossier racine
Set fic = A.Files 'definition de la variables toucher les fichier des dossier
fichier fic 'appel de la fontion fixhier
recurcive A 're-appel de la fonction recurcive pour traiter les S/dossiers
'dossier path
next
end function 'fin de la fonction
function fichier(fic) 'fonction qui traite les fichiers dans les dossiers A
For Each objFile in fic 'pour chaque fichier dans dossiers de fichier
Set f = fso.GetFile(objfile) 'utilisation du FSO pour prendre le fichier
If DateDiff("D", objfile.DateLastModified, now) > 10 Then 'si la derniére modification du fichier est plus ancienne que X jours
'msgbox objfile & " a suprimer" 'alors effacer le fichier avec option de forcer pour les fichier en lecture seule
FSO.DeleteFile f, force = yes
end if 'fin du SI
next
end function 'fin de la fonction
'function dossier(path) 'fonction pour supprimer les dossier vides (taille = 0 )
set folder = FSO.GetFolder (path)'utilisation du FSO pour prendre le dossier
For Each B in folder.subfolders 'pour chaque dossier dans le dossier racine
If B.size = 0 Then 'si la taille du dossier est egal a 0 (donc vide)
'msgbox B & B.size 'effacer le dossier
FSO.DeleteFolder B, force = yes
End If 'fin du SI
Next
'end function 'fin de la fonction
[/code]
