Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 819 fois - Téléchargée 46 fois
Public Enum eREDIRECTION eREDIRECT_FICHIER eREDIRECT_TABLEAU End Enum Public Sub SCANNER_LE_DISQUE2(ByVal LE_REP_DE_DEPART As String, _ ByVal LA_REDIRECTION As eREDIRECTION, _ Optional ByVal LES_MASQUES As String = vbNullString, _ Optional ByRef LE_TABL_DE_SORTIE As Variant, _ Optional ByVal LE_NO_DE_FICHIER As Long = 1) On Error Resume Next 'Obligatoire pour ne pas être emmerdé par les fichier systèmes (jusqu'à autre solution...) Dim I, N As Long Dim LE_COMPTEUR As Long Dim LE_NOM_FICHIER As String Dim LE_TABL_DE_REP_FILS() As String Dim LE_SPLIT_EXT() As String 'Va permettre de récupérer l'extension d'un fichier LE_COMPTEUR = 0 LES_MASQUES = UCase(LES_MASQUES) LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbReadOnly) 'Fichiers sans attribut + Fichiers en lecture seule ... Do While LE_NOM_FICHIER <> "" LE_SPLIT_EXT = Split(UCase(LE_NOM_FICHIER), ".") 'On utilise Split plutôt qu'un Right$(,3) car l'extension peut ne pas compter 3 car ! LE_COMPTEUR = LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) = 0 Then DoEvents If InStr(1, LES_MASQUES, ";" & LE_SPLIT_EXT(UBound(LE_SPLIT_EXT)) & ";") <> 0 Then Select Case LA_REDIRECTION Case eREDIRECT_FICHIER: Print #LE_NO_DE_FICHIER, LE_REP_DE_DEPART & LE_NOM_FICHIER Case eREDIRECT_TABLEAU: ReDim Preserve LE_TABL_DE_SORTIE(1 To 2, UBound(LE_TABL_DE_SORTIE, 2) + 1) As String LE_TABL_DE_SORTIE(1, UBound(LE_TABL_DE_SORTIE, 2)) = LE_REP_DE_DEPART LE_TABL_DE_SORTIE(2, UBound(LE_TABL_DE_SORTIE, 2)) = LE_NOM_FICHIER End Select End If LE_NOM_FICHIER = Dir 'Fichier Suivant Loop 'Cherche ts les répertoires "fils" LE_NOM_FICHIER = Dir(LE_REP_DE_DEPART, vbDirectory) 'Fichiers sans attribut + répertoires ... Do While LE_NOM_FICHIER <> "" LE_COMPTEUR = LE_COMPTEUR + 1: If (LE_COMPTEUR Mod 10) = 0 Then DoEvents If LE_NOM_FICHIER <> "." And LE_NOM_FICHIER <> ".." Then 'On regarde si le fichier est un répertoire. Si tel est le cas, on mémorise son nom 'afin de scruter les sous répertoire de celui-ci par la suite... If (GetAttr(LE_REP_DE_DEPART & LE_NOM_FICHIER) And vbDirectory) = vbDirectory Then 'ATTENTION : Les fic systèmes nous foutent en erreur ! N = N + 1 ReDim Preserve LE_TABL_DE_REP_FILS(N) As String 'Mémorise le nom du répertoire LE_TABL_DE_REP_FILS(N) = LE_REP_DE_DEPART & LE_NOM_FICHIER End If End If LE_NOM_FICHIER = Dir 'Fichier suivant dans la liste extraite par LE_NOM_FICHIER = Dir(CurrentPath, vbDirectory) Loop 'Recense ts les fichiers des répertoires mémorisés => Va nous donner : 1. Une liste de fichiers ' 2. Une autre liste de sous-répertoire (éventuellement) For I = 1 To N SCANNER_LE_DISQUE2 LE_TABL_DE_REP_FILS(I) & "\", LA_REDIRECTION, LES_MASQUES, LE_TABL_DE_SORTIE, LE_NO_DE_FICHIER Next I End Sub Private Sub Form_Load() Dim A() As String Dim J Dim T1, T2 'Open "d:\Files.txt" For Output As #1 T1 = Time ReDim A(1 To 2, 0) As String 'A faire avant d'appeler SCANNER_LE_DISQUE sous peine d'erreur ! 'SCANNER_LE_DISQUE1 "Q:\", eREDIRECT_TABLEAU, ";zip;exe;doc;pdf;", A, 1 SCANNER_LE_DISQUE2 "d:\", eREDIRECT_TABLEAU, ";zip;exe;doc;pdf;", A, 1 For J = LBound(A, 2) + 1 To UBound(A, 2) Debug.Print A(1, J) & A(2, J) Next J 'Close #1 T2 = Time MsgBox DateDiff("s", T1, T2) Unload Me End Sub
13 janv. 2004 à 13:15
13 janv. 2004 à 13:02
20 août 2003 à 17:58
17 mai 2002 à 11:16
LES_MASQUES = UCase(LES_MASQUES)
et modifier : LE_SPLIT_EXT = Split(UCase(LE_NOM_FICHIER), ".")
et là c'est ok.
17 mai 2002 à 10:53
Vous remarquerez que la façon de lister les extensions à changé : il faut IMPERATIVEMENT lister en ";xx1;xx2;" les ";" sont obligatoires au début et à la fin sous peine de voir apparaître des extensions non souhaitées !
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.