[XL 2010] Remplacement de FileSearch [Résolu]

[Thibe64]

Bonjour,
Je suis tout nouveau chez Developez.com, et j'arrive avec une question déjà débattue plusieurs fois. Il s'agit de la fonction FileSearch, plus supportée depuis la version 2007, et les solutions apportées pour XL 2007 que j'ai trouvées sur le site ne fonctionnent pas sur la version 2010 installée tout fraichement sur mon poste...

En gros, voici mon 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
Private Sub Workbook_Open()
 
ActiveSheet.Unprotect
Dim i As Integer
 
Range("b11:b250").ClearContents
Range("a7").ClearContents
Range("g20").Value = "Mise à jour des données... ... ... Merci de patienter !   :)"
 
    With Application.FileSearch
        .NewSearch
        .LookIn = Range("c4") & "\"     '< c'est une donnée entrée par l'opérateur, mais il s'agit surtout d'un emplacement réseau
        .SearchSubFolders = True
        .Filename = "*as300*.*"
    End With
 
    With Application.FileSearch
        If .Execute() > 0 Then
            Range("b11").Select
            For i = 1 To .FoundFiles.Count
                ActiveCell.Value = .FoundFiles(i)
                ActiveCell.Offset(1, 0).Range("A1").Select
            Next i
        Else
            MsgBox "Aucun fichier correspondant à ce critère"
        End If
        Range("A11").Select
    End With
 
 Range("g20").ClearContents
 
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True
 
End Sub

Le but est de recherchez tous les fichiers d'une racine réseau (avec tous ses sous répertoires...) contenant les caractères "AS300", et d'en afficher la liste sur ma feuille avec le path...

Si quelqu'un pouvait m'aider, ça m'enlèverait une sacré épine du pied, parceque depuis que xl2010 est installé sur mon poste, je passe une moitié de mon temps à traficoter sans succès mon code, et l'autre moitié de mon temps à me palucher cette fameuse recherche pour effectuer la mise à jour à la main... truc de fou!
Un Grand Merci A Vous !

Thibe

[Daniel.C]

Bonjour et bienvenue !

mets :

Code :

Public Ligne As Long

dans un module standard. Remplace ta macro par :

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
Private Sub Workbook_Open()
    'Réf. 111107-1.xlsm Thibe64
    ActiveSheet.Unprotect
    Dim i As Integer, FSO As Object
 
    Range("b11:b250").ClearContents
    Range("a7").ClearContents
    Range("g20").Value = "Mise à jour des données... ... ... Merci de patienter !  "
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set dossier_racine = FSO.getfolder(Range("c4").Value)
    Ligne = 10
    Lit_dossier1 dossier_racine
 
End Sub
Sub Lit_dossier1(ByRef dossier)
     For Each f In dossier.Files
        If InStr(1, f.Name, "as300") > 0 Then
            Ligne = Ligne + 1
            Cells(Ligne, 2) = f.Path
        End If
     Next
   For Each d In dossier.SubFolders
     Lit_dossier1 d
   Next
End Sub

[Thibe64]

Bonjour!

Un Grand Daniel.C, C'est tout à fait ce que je cherchais...

J'ai juste indiqué à la fonction InStr comment effectuer la comparaison de texte: "vbTextCompare" (Je ne voulais pas que la casse soit respectée lors de la recherche)

Cependant, je ne suis pas encore arrivé... Lorsque je lance le code, un message d'erreur apparait (que je n'avais pas avec FileSearch ) "Acces Denied"...

Grrr... j'ai cherché à m'en sortir tout seul (comme un grand VBAïste que je ne suis hélas pas ), alors j'ai inséré une etiquette "ZapDoss" juste avant l'instruction " For Each d In dossier.SubFolders", accouplée à l'instruction "On Error Goto ZapDoss" en debut de procédure.
Bon, ça fonctionne mieux, mais un autre message d'erreur du même type "Acces refusé" arrive plus loin dans la procédure...
Why
Je cherche, je cherche...

Bonne journée !

[Daniel.C]

Peux-tu préciser sur quelle ligne tu as ce message d'erreur ?

[Thibe64]

Bonjour,

Le message exact: Erreur d'execution '70', Permission refusée. D'après l'aide de VBA, ce message m'informe que ma procédure tente d'acceder à un fichier protégé...
Il arrive sur la ligne "For each d in dossier.SubFolders", juste sous ma nouvelle étiquette "ZapDoss"... que j'ai créée justement pour éviter ce type de problème!

Je pense que ZapDoss permet de zapper les dossiers protégés, pas les fichiers protégés...

Question inquiétante, juste comme ça : comment se fait-il qu'en passant par "FileSearch", ma macro listait moins de feuilles (aïe aïe aïe, pas bon pour moi ça !!), et s'arretait, donc avant d'avoir fini son boulot ... et le tout sans me balancer de message d'erreur ??

Have a good day

________________________________
Cordialement

[Daniel.C]

FileSearch était connu pour être buggé. C'est pourquoi la méthode a été supprimée. Essaie comme ceci :

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
Private Sub Workbook_Open()
    'Réf. 111107-1.xlsm Thibe64
    ActiveSheet.Unprotect
    Dim i As Integer, FSO As Object
 
    Range("b11:b250").ClearContents
    Range("a7").ClearContents
    Range("g20").Value = "Mise à jour des données... ... ... Merci de patienter !  "
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set dossier_racine = FSO.getfolder(Range("c4").Value)
    Ligne = 10
    On Error Resume Next
    Lit_dossier1 dossier_racine
End Sub
Sub Lit_dossier1(ByRef dossier)
     For Each f In dossier.Files
        If InStr(1, f.Name, "as300") > 0 Then
            Ligne = Ligne + 1
            Cells(Ligne, 2) = f.Path
        End If
     Next
   For Each d In dossier.SubFolders
     Lit_dossier1 d
   Next
End Sub

[Thibe64]

Ben... Avec ta dernière proposition, plus de message d'erreur. Seulement la procédure ne liste que 55 fichiers... (contre 200 avant). J'imagine qu'elle doit sortir de sa boucle dès le premier répertoire protégé
Du coup, j'ai gardé mon étiquette, puis j'ai rajouté une ligne "On Error Resume Next", juste en dessous de la commande "For Each d In dossier.SubFolders"... Je ne sais pas si c'est bien catholique comme procédé, mais de toute façon, ça marche moyen : la procédure liste quand même 175 fichiers, il n'y a plus de message d'erreur, mais le compte n'y est toujours pas... A n'y rien comprendre

En tout état de cause, je pars enfin en we, ça fera un peu de recul et puis ma fois, Lundi il fera jour! les ressources de VBA pour excel sont inépuisables, pas les miennes, hélas !
Je te remercie encore pour ton aide, qui m'a jusqu'ici bien fait avancer !

Bonne soirée

________________________________
Cordialement

[Daniel.C]

Le problème vient des droits sur les dossiers et les fichiers. Je n'ai aucun problème avec les dossiers de mon disque local.

[Thibe64]

Bonjour Daniel.C,

Après (encore) quelques heures de recherches, je pense que je vais rester sur la solution de la semaine dernière. Elle n'est pas parfaite, mais déjà nettement plus performante que ma procédure utilisant FileSearch... c'était le but.
Ton aide m'a sorti de l'ornière, et je t'en remercie encore.
Bonne continuation!