0/5 (8 avis)
Snippet vu 11 758 fois - Téléchargée 19 fois
Option Explicit 'déclaration obligatoire des variables Public Type TypeFichier nom As String repertoire As String taille As Long End Type Public ListeFichiers() As TypeFichier ' Public Sub liste_fichiers() Dim Dossier As String Dim NbreFicTot As Long Debug.Print String(100, "*") ReDim ListeFichiers(0 To 0) As TypeFichier Dossier = "D:\transfert" Call Dir_Fichiers(Dossier) NbreFicTot = UBound(ListeFichiers) MsgBox NbreFicTot & " fichiers", vbInformation, "Fin Liste Fichiers" End Sub Public Sub Dir_Fichiers(ByVal Dossier As String) 'utilise la Variable globale : 'ListeFichiers() as TypeFichier Dim Chemin As String Dim FichierLu As String Dim NbreFichiersLus As Long, NbreFichiers As Long Dim i As Long NbreFichiersLus = 0 Chemin = Dossier + "\" 'liste les fichiers et les dossiers avec l'option vbDirectory FichierLu = Dir(Chemin, vbDirectory) Do While FichierLu <> "" NbreFichiersLus = NbreFichiersLus + 1 If FichierLu <> "." And FichierLu <> ".." Then If (GetAttr(Chemin & FichierLu) And vbDirectory) = vbDirectory Then 'c'est un répertoire, on l'examine de facon récursive Debug.Print "Dossier: " & Chemin & FichierLu & " " & String(70, "-") Call Dir_Fichiers(Chemin & FichierLu) Debug.Print "Fin Dossier: " & Chemin & FichierLu & " " & String(70, "-") 'après avoir examiné le sous-dossier, il faut repositionner Dir sur l'entrée suivante 'car la fonction dir n'est pas récursive et a donc perdue la dernière position 'on réinitialise donc Dir et repositionne le flag à la bonne place avec NbreFichiersLus FichierLu = Dir(Chemin, vbDirectory) For i = 1 To NbreFichiersLus - 1 FichierLu = Dir Next i Else 'c'est un fichier, on le met dans la liste globale 'augmente de 1 la taille de la liste en préservant le contenu du tableau de la liste Debug.Print FichierLu NbreFichiers = UBound(ListeFichiers) + 1 ReDim Preserve ListeFichiers(0 To NbreFichiers) As TypeFichier 'ajoute le fichier à la liste ListeFichiers(NbreFichiers).nom = FichierLu ListeFichiers(NbreFichiers).repertoire = Chemin ListeFichiers(NbreFichiers).taille = FileLen(Chemin & FichierLu) End If End If 'passe à l'entrée suivante de la fonction Dir FichierLu = Dir Loop End Sub
3 févr. 2012 à 22:31
Il est vrai que la fonction Scan (exemple ci-dessus) pose problème
pour des fichiers en réseau (\\remotehost\share\fichier.txt)
Exemple: pour scanner un dossier en réseau de 200 fichiers il faut plus de 10 mn alors que pour
le même dossier en local il ne faut que quelques secondes
Même si le temps d'accès à un fichier en réseau est plus long que pour un fichier
en local, je ne comprends pas pourquoi dans ce cas le scan est aussi lent.
3 févr. 2012 à 09:32
Simplicité d'écriture le code VB, mais limité à taille en octets sur 32 bits (limite VB6)
donc fichier(s) ou addition de fichiers dans un dossier inférieures à 2 go (environ)
Le FSO (filesystemObject) est simple à utiliser / coder par rapport à l'api et fonctionne avec
une property size sur 64 bits.
A noter qu'on ne peut ouvrir / gérer un fichier avec une syntaxe UNC (\\remotehost\share)
\fichier.txt) en DOT.NET l'utilisation UNC, par exemple pour créé un dossier fonctionne.
5 déc. 2011 à 12:41
Permet de mettre tous les sous-dossiers d'un dossier dans une liste (ListDoss)
et tous les fichiers des sous-dossiers dans une autre liste (ListFich)
Il faut initialiser les 2 listes (ListView) et référencer microsoft scripting runtime
Dim Dossier As Folder, Sousdossier As Folder, Fichier As File
Dim fso As FileSystemObject
Private Sub Form_Load()
Scan_Dossier "c:\MonDossier"
End Sub
Sub Scan_Dossier(ByVal Dossier As Folder)
On Error GoTo Erreur
Dim PlusDossier as Boolean
For Each Fichier In Dossier.Files
If PlusDossier = False Then Set itmx ListDoss.ListItems.Add(, , Dossier): PlusDossier True
End If
Set itmy = ListFich.ListItems.Add(, , Fichier)
Next
PlusDossier = False
For Each Sousdossier In Dossier.SubFolders
Scan_Dossier Sousdossier
Next
Set itmx = Nothing
Set itmy = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
Err.Clear
End Sub
2 déc. 2011 à 08:51
fileSCRIPTINGobject le bien nommé est a reserver au scripting
trop lent en dehors...
ca fonctionne, mais c'est lent et ajoutes une dépendance
1 déc. 2011 à 18:53
Option Explicit
Sub test()
listerDossiers ("c:")
End Sub
Sub listerDossiers(Optional sFolder As String = "")
Dim fso As FileSystemObject
Dim fld As Folder
Dim fldParent As Folder
Set fso = New FileSystemObject
Set fldParent = fso.GetFolder(sFolder)
For Each fld In fldParent.SubFolders
Debug.Print fld.Path & "-" & fld.Size
Call listerDossiers(fld.Path)
DoEvents
Next
End Sub
Il faut bien sur référencer microsoft scripting runtime
JJDai
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.