[VB]Recherche récursive...

Bonjour,
j'aimerais trouver le moyen de faire une recherche de fichiers sur une partition, donc dans une arborescence. J'ai chercher sur ce forum pour finallement apprendre que dir() n'est pas une solution. J'ai aussi trouvé un post qui donne une technique de recherche mais c'est du vba et non du vb et même en supprimant la première ligne, comme expliqué dans le post, je concerve des messages d'erreur... Quelqu'un aurait un bout de code pour moi???

Hello!
C'est quoi, cette solution VB mais pas VBA qui ne marche pas même en supprimant une mystérieuse dernière ligne?
Montre nous ce code, on va voir si on peut en faire quelquechose.
Il utilise le FSO?

Heu, c'est un fait, j'ai pas réfléchis sur ce coup-là...

Citation:

salut, voici ma fonction pour une recherche de fichier

biensur, il faut l'adapter pour ton projet

Dans un module:

Code:

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

Procédure qui appel la fonction rechercher:
Code:

Code:

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
Private Sub BtnLancerRech_Click() 
 
 
If ((Not IsNull(edtPath.Value)) And (edtPath.Value <> "")) Then 
    btnFocus.SetFocus 
    BtnRech.Visible = False 
    BtnLancerRech.Visible = False 
    BtnAnnulerRech.Visible = True 
 
    Dim ResultatRecherche As ListeFichier 
    Dim NombreOccurence As Long 
    Dim I As Integer 
    Dim r As Variant 
 
    '---Recherche de tous les fichiers 
    lstPath.RowSource = "Résultat de la recherche;" 
    AnnulerRech = False 'variable public pour annuler la recherche (true = annuler) 
    SysCmd acSysCmdSetStatus, " " 
    Select Case MainOptionBD.Value 
        Case 1: NombreOccurence = Rechercher(edtPath.Value, BDGift, ResultatRecherche) 
        Case 2: NombreOccurence = Rechercher(edtPath.Value, BDCorporatif, ResultatRecherche) 
        Case 3: NombreOccurence = Rechercher(edtPath.Value, BDDeveloppement, ResultatRecherche) 
        Case 4: NombreOccurence = Rechercher(edtPath.Value, BDCorporatif_Developement, ResultatRecherche) 
        Case 5: NombreOccurence = Rechercher(edtPath.Value, BDGOD, ResultatRecherche) 
    End Select 
    ' Toutes les informations de la recherche sont dans la variables ResultatRecherche 
    For I = 1 To NombreOccurence 
        lstPath.RowSource = lstPath.RowSource & Trim$(ResultatRecherche.Chemin(I)) & Trim$(ResultatRecherche.Fichiers(I).cFileName) 
        lstPath.RowSource = lstPath.RowSource & ";" 
    Next 
    BtnRech.Visible = True 
    BtnLancerRech.Visible = True 
    BtnAnnulerRech.Visible = False 
    Else: MsgBox "Veuillez sélectionner un chemin pour la recherche.", vbInformation, "Information" 
End If 
End Sub

La ligne à retirer est la première d'après le post (Option Compare Database) Mais chez moi, ça passe tojours pas...

Punaise ! Je préfère VBA !

With Application
MsgBox Workbooks("Classeur5.xls").path
End With

Et moi, le java... Mais pas le choix du langage... :lol:

salut!
le cd-rom de msdn contient la solution au pb de recherche de fichier dans tout l'ordi. il suffit de parcourir les démos vb qu'il contient.

Ca ne fait pas ce que tu veux, ça :
http://vb.developpez.com/sources/?pa...onF#scanfolder

C'est génial, la solution fonctionne, je n'ai plus qu'à l'adpter un minimum... Merci...
Au passage, est-ce que l'un de vous sait comment marquer une pause dans une exécution??? Genre l'exécution du prog s'interromp pendant 5 seconde...

Tu as sleep :
Code:

1 2 3 4 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub pause() Sleep 5000 'en millisecondes End sub
Aimablement offert par DarkVader mais il te dirait certainement qu'il y a mieux ou plus adapté.

A+

C'est génial... Merci beaucoup...

J'avais testé le programme que Thierry AIM m'a proposé avec un nom de fichier bien précis, ça a fonctionné, parcontre, lorsque j'essaie avec *.txt par exemple, ça ne ressort strictement rien... Comment celà se fait-il???

Voici la fonction de recherche qui ma fois, me semble très courte...

Code:

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
Public Function ScanFolder(FolderPath As String, Optional Filename As String = "", Optional SubFold As Boolean = True) As Long
' Fonction récursive pour l'exploration des répertoires
 
    Dim Element As Variant
    Dim StrPath() As String
 
    ScanFolder = fs.GetFolder(FolderPath).Files.Count
 
    For Each Element In fs.GetFolder(FolderPath).Files
        Form1.StatusBar1.Panels(1).Text = FolderPath
        If Filename <> "" Then
            StrPath = Split(Element, "\")
            If InStr(1, StrPath(UBound(StrPath)), Filename) Then _
                    Form1.List1.AddItem Element
        Else
            Form1.List1.AddItem Element
        End If
        DoEvents
    Next Element
 
    If SubFold Then
        For Each Element In fs.GetFolder(FolderPath).SubFolders
            ScanFolder = ScanFolder + ScanFolder(Element.Path, Filename, SubFold)
        Next Element
    End If
End Function

Je présume que l'endroit où ça cloche est le moment de la comparaison mais quoi y mettre???

En regardant le code plus attetivement, j'ai trouvé mon erreur... La fonction utilisée est instr, l'étoile devenait donc un caractère superflux qui me mettait tout en pièce...