Discussion :

[venusfr]

Bonjour à tous,

étant passée à Office 2010 la méthode FileSearch ne marche bien évidement pas. J'ai lu les Post sur l'utilisation de ClasseFileSearch mais çà ne résout pas mon problème!
je me sers de ma macro pour rechercher les fichiers d'un répertoire :
- dont le nom contient "affecipr"
- quelque soit le type
- dont la date de modification est comprise entre 2 dates précises.
La macro proposée ne permet pas les filtres d'après ce que j'ai lu...

Si vous pouviez m'aider!

Merci par avance.

[Theze]

Bonjour,

Une piste avec FSO. Cette fonction retourne les trois dates qui consernent le fichier, date de création, dernier accès et dernière modif. Lance la proc "Test" après avoir adapté le chemin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Function ProprietesFichier(Dossier As String, _
                           Fichier As String) As String()
 
    Dim Fso As Object
    Dim Fich As Object
    Dim Tbl() As String
 
    'le fichier doit exister sinon, la fonction
    'retourne "Fichier introuvable"
    If Dir(Dossier & Fichier) <> "" Then
 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set Fich = Fso.GetFile(Dossier & Dir(Dossier & Fichier))
 
        With Fich
 
            ReDim Tbl(1 To 3)
 
            Tbl(1) = .DateCreated
            Tbl(2) = .DateLastAccessed
            Tbl(3) = .DateLastModified
 
        End With
 
        ProprietesFichier = Tbl()
 
    Else
 
        ReDim Tbl(1 To 1)
        Tbl(1) = "Fichier introuvable"
        ProprietesFichier = Tbl()
 
    End If
 
 
    Set Fich = Nothing
    Set Fso = Nothing
 
End Function
 
Sub Test()
 
    Dim Tbl() As String
    Dim I As Integer
 
    Tbl = ProprietesFichier("F:\", "*affecipr*.xls")
 
    For I = 1 To UBound(Tbl)
 
        Debug.Print Tbl(I)
 
    Next I
 
End Sub

Hervé.

[Didier Gonard]

Bonjour,

Sinon, la foncion Dir permet l'utilisation des Jokers ( * ou ?), assez pratique dans ces cas de figure, des exemples existent en faisant une recherche sur le forum

Cordialement,

Ps : si le côté technique de la réponse = OK ou pas => pensez à cliquer sur les pouces et quand question résolue à la taguer résolue, et chaque action vous rapporte des points

Didier

[venusfr]

Bonjour Hervé, Didier et merci de vos réponses

je vais tester voire en cumulant les deux.

je vous tiens au courant.

bonne journée
Catherine.

[venusfr]

et bien voilà j'ai fait un mix pour obtenir un code qui marche mais je regrette mon FileSearch!

Merci et bonne journée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Option Base 1
Public Type InfosResultFichiers
    strFileName As String
    DateLastModified As Date
End Type
Sub test()
 
 
 
    Dim Fso As Object
    Dim Fich As Object
    Dim Dossier, Fichier, NomDossier As Object, SousDossier As Object
    Dim objFichier As Object
    Dim TabFiles() As InfosResultFichiers
    Dim lngFoundFilesCount As Long
    Dim poste As InfosResultFichiers
    Dim valeur As Integer
    Dim z, i As Integer
 
 
    lngFoundFilesCount = 0
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Dossier = "P:\XR38\Data\In\PXR3801\"
    Fichier = "kaudit_affecipr_*"
 
    'Les fichiers Kaudit doivent exister sinon gros problème
 
    If Dir(Dossier & Fichier) = "" Then
        z = MsgBox("Aucun fichier Kaudit trouvé!!!", vbOKOnly, "", "", "")
    End If
 
    Set NomDossier = Fso.GetFolder(Dossier)
 
    'Boucle sur les fichiers du répertoire et chargement en table des fichier Kaudit
    For Each objFichier In NomDossier.Files
 
        'Vérifie l'extension du fichier
        If objFichier.Name Like "*.csv" Then
 
 
            If Left(objFichier.Name, 16) = "kaudit_affecipr_" Then
                'Redimensionne le tableau pour ajouter un nouvel élément
                lngFoundFilesCount = lngFoundFilesCount + 1
                ReDim Preserve TabFiles(lngFoundFilesCount)
 
                'Nom fichier
                TabFiles(lngFoundFilesCount).strFileName = objFichier.Name
                'Date de création ou dernière modification
                TabFiles(lngFoundFilesCount).DateLastModified = objFichier.DateLastModified
                End If
        End If
    Next objFichier
 
'tri de la table sur dates modif
     Do 'tri décroissant
        valeur = 0
 
        For i = 1 To UBound(TabFiles) - 1
            If TabFiles(i).DateLastModified < TabFiles(i + 1).DateLastModified Then
                poste = TabFiles(i)
                TabFiles(i) = TabFiles(i + 1)
                TabFiles(i + 1) = poste
                valeur = 1
            End If
        Next i
    Loop While valeur = 1
 
 
 
 
 
 
    Set Fso = Nothing
 
 
End Sub