[VBA Excel] Imiter le fonctionnement de "Rechercher"

Version imprimable

13/06/2008, 13h25
ancel17

[VBA Excel] Imiter le fonctionnement de "Rechercher"

Bonjour,

Mon problème est le suivant :
Je voudrais pouvoir à partir d'un dossier dont le chemin d'accès est connu parcourir tous les sous-dossiers compris dans ce dossier pour trouver tous les fichiers Excel dont le nom contient DSCP et 23-05-08.

Exemple :
chemin = \\Senthag03\partage\Acc\Projet\Cost\SUIVI INGENIERIE PAR AFFAIRE

Tous les fichiers recherchés se trouvent quelque part dans ce dossier, mais il peut y avoir plusieurs sous-dossiers intermédiaires (1 minimum)

Le but est d'imiter le fonctionnement de "Rechercher" de Windows accessible depuis le "Menu Démarrer", en basant la recherche sur chemin.

J'espère avoir été assez clair...

Merci de votre aide !

bonjour,

une petite chose dans le style devrait t'aider

il faut ajouter une référence à microsoft scripting runtime

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub test()
Dim FSO As New FileSystemObject
Dim Fo As Folder, Fi As File
Dim Papat As String, strSearch(1) As String
 
'Dossier de départ
Papat = "\\Senthag03\partage\Acc\Projet\Cost\SUIVI INGENIERIE PAR AFFAIRE"
'Parties de nom à rechercher
strSearch(0) = "DSCP": strSearch(1) = "23-05-08"
 
For Each Fo In FSO.GetFolder(Papat).SubFolders
    For Each Fi In Fo.Files
        If InStr(Fi.Name, strSearch(0)) Then
            If InStr(Fi.Name, strSearch(1)) Then Debug.Print f.Name
        End If
    Next
Next
 
End Sub

16/06/2008, 13h28
ancel17

Nickel !

ça marche du feu de Dieu !!!

juste une petite correction dans le code :
remplacer

Code:

Debug.Print f.Name

par

Code:

Debug.Print Fi.Name

Merci ! :king:
16/06/2008, 13h30
mayekeul

Citation:

ça marche du feu de Dieu !!!

si vite que ça?
;)

Citation:

juste une petite correction dans le code :

juste, je m'ai pas relu :)

un pti click sur :resolu: ?
16/06/2008, 14h31
ancel17

Très juste !

Dans ma hate, je l'ai zappé...
Une fois n'est pas coutume !
16/06/2008, 17h30
ancel17

Autant pour moi...

le code proposé fonctionne effectivement du feu de Dieu, mais uniquement dans le cas où il n'y a qu'un niveau de sous-dossier...

Problème :
Je voudrais aller fouiller dans tous les sous-dossiers des sous-dossiers des sous-dossiers... du dossier de base ! :aie:

bonjour,

a chaud, il faut faire un truc du genre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test(strDossier As String)
Dim FSO As New FileSystemObject
Dim FO As Folder, Fi As File
Dim Papat As String, strSearch(1) As String
 
'Parties de nom à rechercher
strSearch(0) = "DSCP": strSearch(1) = "23-05-08"
 
For Each FO In FSO.GetFolder(strDossier).SubFolders
    test (FO.Path)
    For Each Fi In FO.Files
        If InStr(Fi.Name, strSearch(0)) Then
            If InStr(Fi.Name, strSearch(1)) Then Debug.Print f.Name
        End If
    Next
Next
 
End Sub

17/06/2008, 13h30
ancel17

Bonjour,

j'ai un soucis avec ton dernier code qui me donne le message d'erreur :

Citation:

Espace pile insuffisant

Donc je tente autrement, je passe par application.filesearch
ça à l'air de pas mal fonctionner mais j'ai une petite question la récupération d'une chaine de caractère.

Si tu veux bien y jeter un oeil, j'ai ouvert un nouveau post ici

Je posterai mon code quand il sera opérationnel pour ceux qu'une telle fonction pourrait intéresser !
17/06/2008, 13h34
mayekeul

Citation:

Espace pile insuffisant

c'est sur que niveau gain de mémoire, ce n'est pas le mieux.

surtout si il doit scanner bcp de folder.

sinon, j'yva voir

:)

Comme promis, le code qui va bien :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub CommandButton1_Click()
 
Dim Fl As Worksheet
Dim strSearch(1) As String, NomFich As String
 
Set Fl = ThisWorkbook.Worksheets(1)
 
strSearch(0) = Fl.Range("A2").Value: strSearch(1) = Fl.Range("A3")
 
        With Application.FileSearch
            .NewSearch
            .LookIn = "adresse du dossier dans lequel effectuer la recherche"
            .SearchSubFolders = True
            .Filename = "*" & strSearch(0) & "*" & strSearch(1) & "*"
            If .Execute > 0 Then
                For i = 1 To .FoundFiles.Count
                    MsgBox  StrReverse(Left(StrReverse(.FoundFiles(i)), InStr(StrReverse(.FoundFiles(i)), "\") - 1))
                Next i
            End If
        End With
 
End Sub

Merci Mayekeul pour ton aide !
Et je n'oublie pas Ouskel'n'or pour le StrReverse qui est quand même super sexy !!!

Ah si ! Ce code fait partie d'une petite contribution qui se trouve par ici !