1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
Option Compare Database
Option Explicit
Public AnnulerRech As Boolean
'----------------------------------------
'------Déclarations propres aux API------
'----------------------------------------
'---Les constantes---
Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
'---Les API---
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'---Les types---
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'----------------------------------------------
'------Déclarations propres à la fonction------
'----------------------------------------------
Public Type ListeFichier
Fichiers() As WIN32_FIND_DATA
Chemin() As String * MAX_PATH
Nombre As Long
End Type
'--------------------------------------------------------
'---La fonction Rechercher : ---
'--- Cette fonction recherche tous les fichiers dans ---
'--- le répertoire spécifié et ses sous-repertoires ---
'--- Elle retourne le nombre d'occurences trouvées ---
'--- Elle commence par rechercher tous les dossier ---
'--- ensuite elle fait une recherche pour des sous-dossier ---
'--- si sous-dossier trouvé, alors recommence la recherche de fichier ---
'--------------------------------------------------------
Public Function Rechercher(Chemin As String, FichierR As String, _
ResultatRecherche As ListeFichier) As Long
'---Déclaration des variables---
Dim lpFindFileData As WIN32_FIND_DATA
Dim hFindFile As Long
Dim lgRep As Long
Dim CheminRep As String
'---Recherche tous les fichiers demandés dans le répertoire Chemin---
hFindFile = FindFirstFile(Chemin & FichierR, lpFindFileData)
If hFindFile <> INVALID_HANDLE_VALUE Then
'###############
'ICI ON RECHERCHE TOUS LES FICHIER QUI PORTE LE NOM DE FichierR
'IL NE CHERCHE QUE CE FICHIER LA, ALORS IL SAUTE TOUS LES AUTRES
'###############
Do
' Mémorise
ResultatRecherche.Nombre = ResultatRecherche.Nombre + 1 'AUGEMENTE LE NOMBRE DE FICHIER TROUVÉ DE 1
ReDim Preserve ResultatRecherche.Chemin(1 To ResultatRecherche.Nombre) 'REDIMENSIONNE LE TABLEAU AVEC LA NOUVELLE TAILLE
ReDim Preserve ResultatRecherche.Fichiers(1 To ResultatRecherche.Nombre) 'REDIMENSIONNE LE TABLEAU AVEC LA NOUVELLE TAILLE
ResultatRecherche.Chemin(ResultatRecherche.Nombre) = Chemin 'MÉMORISE LE CHEMIN DU FICHIER TROUVÉ
ResultatRecherche.Fichiers(ResultatRecherche.Nombre) = lpFindFileData 'MÉMORISE LE NOM DU FICHIER TROUVÉ
' Initialise lpFindFileData (Variable texte uniquement)
lpFindFileData.cAlternate = String$(14, 0)
lpFindFileData.cFileName = String$(MAX_PATH, 0)
DoEvents
'BOUCLE TANT QU'IL RESTE DES FICHIER OU QUE LA VARIABLE ANNULERRECH = TRUE
Loop Until FindNextFile(hFindFile, lpFindFileData) = 0 Or AnnulerRech = True
End If
FindClose hFindFile 'FERME L'INSTANCE
'---Recherche dans les sous-répertoires---
'###############
'ICI ON CHERCHE TOUT LES FICHIER\DOSSIER QUI CONTIENT UN .
'###############
hFindFile = FindFirstFile(Chemin & "*.*", lpFindFileData)
If (hFindFile <> INVALID_HANDLE_VALUE) Then
Do
' Si c'est un répertoire on continu la recherche
'LA RECHERCHE DES FICHIERS EST EFFECTUÉ PLUS HAUT, ALORS CE QU'ON CHERCHE C'EST SEULEMENT LES RÉPERTOIRE
If (lpFindFileData.dwFileAttributes And _
FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then 'C'EST UN RÉPERTOIRE, ALORS IL FAUT VÉFIFIER QUE LE RÉPERTOIRE N'EST PAS LE . OU ..
' Extraction du nom du répertoire
CheminRep = Mid$(lpFindFileData.cFileName, 1, _
InStr(1, lpFindFileData.cFileName, Chr$(0)) - 1)
' Attention dans les sous-répertoire aux
' répertoires . et .. (Retour répertoire parent)
'VÉRIFICATION DU RÉPERTOIRE
If (CheminRep <> ".") And (CheminRep <> "..") Then
'LE RÉPERTOIRE N'EST PAS . OU ..
CheminRep = Chemin & CheminRep & "\" 'MÉMORISE LE NOM DU RÉPERTOIRE DANS UNE VARIABLE
SysCmd acSysCmdSetStatus, "Dossier: " & CheminRep
Rechercher = Rechercher(CheminRep, FichierR, ResultatRecherche) 'RELANCE LA FONCTION RECHERCHER DANS LE SOUS-RÉPERTOIRE
End If
End If
DoEvents
'TANT QU'IL Y A DES FICHIER\DOSSIER ET ANNULERRECH = TRUE
Loop Until FindNextFile(hFindFile, lpFindFileData) = 0 Or AnnulerRech = True
End If
FindClose hFindFile 'FERME L'INSTANCE
SysCmd acSysCmdClearStatus
'---Retourne le nombre d'occurrences trouvées---
Rechercher = ResultatRecherche.Nombre 'RETOURNE LE NB D'OCCURENCE
End Function |
recherche arborescence plus rapide
je fais le poirier ...merci à vous
Répondre avec citation
Envoyé par Catbull
)
Partager