[XL-2010] Migration de macro Excel 97 -> 2010 FileSearch bloque

[ulous]

Bonjour,

Je suis un jeune consultant junior SAP qui a eu le malheur de faire apparaitre VBA sur son CV... résultat je suis responsable débuggage de macro depuis 6mois... J'ai appris sur le tas et me débrouille pas mal mais aujourd'hui on me demande de passer des macro sous 2010 car elles ne fonctionne plus.

Mon problème vient de cette commande : Application.FileSearch

J'ai pas mal regarder sur le net, mais je m'y retrouve pas et je surchauffe. pourriez-vous m'aider?

Voici le 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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Private Sub PurgeFic()
 
Dim CptFic As Integer
Dim CptRech As Integer
 
 
    For CptRech = 1 To 2
 
        ' Boucle sur les fichiers pour
        '     les CATT : Y_O_LANCECATT*.TXT
        '     les eCATT : VAR_ECTC_Y_O_LANCECATT*.TXT
 
        '===========================================
        ' Recherche des résultats des tests
        '
        With Application.FileSearch
            .NewSearch
            .LookIn = "C:\Users\JD002870\AppData\Local\SapWorkDir"
'.LookIn = "C:\Donnees\SAPworkdir\"
            .SearchSubFolders = False
            If CptRech = 1 Then
                .Filename = "Y_O_LANCECATT*.TXT"
            Else
                .Filename = "VAR_ECTC_Y_O_LANCECATT*.TXT"
            End If
            .MatchTextExactly = True
            .FileType = msoFileTypeAllFiles
        End With
 
        '===========================================
        ' Parcours des fichiers
        '
        With Application.FileSearch
            If .Execute() > 0 Then
                For CptFic = 1 To .FoundFiles.Count
                    fs.DeleteFile (.FoundFiles(CptFic))
                Next CptFic
            End If
        End With
    Next
 
    '===========================================
    ' Rétablissement des valeurs par défaut
    '
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\My Documents"
        .SearchSubFolders = True
        .Filename = "Run"
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
    End With
 
    Sheets(2).Activate
    Application.ScreenUpdating = False
 
End Sub

Si j'ai bien compris je dois créer un filesystemobject (Fichier) que je vais chercher dans un autre objet (Dossier) mais là j'ai beau essayer je bloque.

Merci pour l'aide que vous pourrez m'apporter.

[Ormonth]

Bonjour,

J'ai pas mal regarder sur le net,

sur DVP ?

voir ici : http://silkyroad.developpez.com/vba/classefilesearch/

cordialement,

Didier

[ulous]

Le problème c'est que là il faut "installer" un complément que tout le monde n'a pas et on m'a explicitement demander de passer par un code qui fonctionnera sur toutes les machines sans avoir besoin de ça...

Merci quand même, si tu as une autre référence web, je suis preneur, mais j'ai déjà chercher comme je l'ai dit.

[Ormonth]

Envoyé par ulous

..on m'a explicitement demander de passer par un code qui fonctionnera sur toutes les machines sans avoir besoin de ça...
j'ai déjà chercher comme je l'ai dit.

on ne pouvait pas le deviner

cordialement,

Didier

[Ormonth]

Bonjour,

c'est un truc du genre que tu cherches ?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Sub ChercheEtTrouve()
Dim strChem
Dim I As Long
‘strChem = Dir("C:\Pass Divers\*.png")
strChem = Dir("E:\+ Toto Listes\05-BASE DE DONNEES\06-DOCUMENTS MODELES\ ANALYSES\*.*")
Do While Len(strChem) > 0
    Debug.Print strChem
    I = I + 1
    strChem = Dir
Loop
Debug.Print I & " fichier(s) trouvés"
End Sub

sinon, pour FSO, voir : http://warin.developpez.com/access/fichiers/#LI

cordialement,

Didier

[ulous]

Désolé pour l'oubli...

Je crois que ton lien m'a permit de débloquer la situation en allant au plus simple.

Je termine et posterai mon code.

Merci