Discussion :

[Razmote]

Bonjour à tous.

J'ai une base de données Access 97 que je suis en train de migrer vers 2010.

J'ai un gros soucis suite à la perte de FileSearch.

J'ai un formulaire qui affiche des documents word dans une fenêtre, le soucis c'est que le dossier ou se trouve ces documents contient des milliers de fichiers, dans le style 78990-0.doc 78991-0.doc 78991-1.doc.

Hors je ne dois afficher que les fichiers qui correspondent à des numéros de dossier, par exemple 79991-*.doc.

Sous access 97 et avec FileSearch l'affichage se fait quasi instantannément, mais j'ai du réécrire FileSearch (en m'aidant des codes trouvés sur ce forum) puisque celui ci n'existe plus et la même opération prend plusieurs minutes.

En gros voici ce que j'ai fait :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set NomDossier = Fso.GetFolder(strFolderName)
 
    ' Boucle sur les fichiers du répertoire
    For Each objFichier In NomDossier.Files
        ' Vérifie l'extension du fichier
        If objFichier.Name Like strextens Or strextens = "" Then
              ' mise dans un tableau le nom du fichier trouvé.
        End If
    Next objFichier

Le problème c'est que j'ai plus de 20000 fichiers dans ce dossier et que je dois en récupérer que quelques uns...

Y a t il une autre solution que de balayer l'intégralité du dossier pour trouver ce que je cherche ?

Merci d'avance

[Razmote]

Bon en partant des codes trouvés ici et la j'ai repondu un code.

Fonction de recherche, avec nom dossier départ, nom de fichier, tri, ordre de tri

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
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
 
Option Compare Database
Option Explicit
Option Base 1
 
' table info fichiers
Public Type TypeFileInfo
    FileName As String
    PathName As String
    Size As Long
    DateCreated As Date
    DateLastModified As Date
    type As String
End Type
' -----------------------------------------------------------------------
' Recherche de fichiers : nom du dossier de départ, fichier à rechercher, type de tri, sens du tri, tableau contenant le résultat, recherche dans sous dossier.
NewFileSearch retourne le nombre de fichier trouvé, ou 0 si aucun.
' -----------------------------------------------------------------------
Function NewFileSearch(FolderStart As String, FileExt As String, SortBy As String, SortDirection As String, tabfiles() As TypeFileInfo, Optional SearchSubFolder As Boolean) As Long
    Dim Fso As Object
    Dim FolderName As Object, SubFolder As Object
    Dim CptFile As Long
    Dim DirectoryPath As String
    Dim FileName As String
    Dim FileInfo As Scripting.File
 
    CptFile = 0
 
    FileName = dir(FolderStart & FileExt)
    ' Vérifie si le dossier spécifié existe
    ' If dir(strFolderName, vbDirectory Or vbHidden Or vbSystem) = "" Then Exit Function
    If FileName = "" Then
        NewFileSearch = 0
        Exit Function
    End If
    Set Fso = New Scripting.FileSystemObject
 
    ' boucle sur les fichiers trouvés
    Do
        If FileName = "" Then Exit Do
        CptFile = CptFile + 1
        ReDim Preserve tabfiles(CptFile)
        ' récupération des info du fichier
        Set FileInfo = Fso.GetFile(FolderStart & FileName)
        With FileInfo
            tabfiles(CptFile).FileName = .Name
            tabfiles(CptFile).DateCreated = .DateCreated
            tabfiles(CptFile).DateLastModified = .DateLastModified
            tabfiles(CptFile).Size = .Size
            tabfiles(CptFile).type = .type
            tabfiles(CptFile).PathName = .Path
        End With
        FileName = dir
   Loop
 
    ' Boucle récursive si l'option de recherche dans les sous répertoires a été spécifiée (pas encore testé)
    If SearchSubFolder Then
        For Each SubFolder In FolderName.SubFolders
            NewFileSearch SubFolder.Path, FileExt, SortBy, SortDirection, tabfiles, SearchSubFolder
        Next SubFolder
    End If
    ' tri du résultat
    If Nz(SortBy, "") <> "" And CptFile > 0 Then FilesSort tabfiles, SortBy, SortDirection
 
    ' retourne le nombre de fichier trouvé
    NewFileSearch = CptFile
 
    Set Fso = Nothing
    Set FileInfo = Nothing
End Function
' -----------------------------------------------------------------------
' tri des éléments fichiers
' -----------------------------------------------------------------------
Sub FilesSort(tabfiles() As TypeFileInfo, SortBy As String, SortDirection)
    Dim i As Long, j As Long, k As Long
    Dim tabfilestemp As TypeFileInfo
 
    ' Vérifie quel champ du tableau doit être trié
    For i = LBound(tabfiles) To UBound(tabfiles)
        j = i
        For k = j + 1 To UBound(tabfiles)
            If SortBy = "name" Then
                If SortDirection = "asc" Then
                    If tabfiles(k).FileName <= tabfiles(j).FileName Then j = k
                Else
                    If tabfiles(k).FileName >= tabfiles(j).FileName Then j = k
                End If
            End If
            If SortBy = "path" Then
                If SortDirection = "asc" Then
                    If tabfiles(k).PathName <= tabfiles(j).PathName Then j = k
                Else
                    If tabfiles(k).PathName >= tabfiles(j).PathName Then j = k
                End If
            End If
            If SortBy = "size" Then
                If SortDirection = "asc" Then
                    If tabfiles(k).Size <= tabfiles(j).Size Then j = k
                Else
                    If tabfiles(k).Size >= tabfiles(j).Size Then j = k
                End If
            End If
            If SortBy = "datecreated" Then
                If SortDirection = "asc" Then
                    If tabfiles(k).DateCreated <= tabfiles(j).DateCreated Then j = k
                Else
                    If tabfiles(k).DateCreated >= tabfiles(j).DateCreated Then j = k
                End If
            End If
            If SortBy = "datelastmodified" Then
                If SortDirection = "asc" Then
                    If tabfiles(k).DateLastModified <= tabfiles(j).DateLastModified Then j = k
                Else
                    If tabfiles(k).DateLastModified >= tabfiles(j).DateLastModified Then j = k
                End If
            End If
            If SortBy = "type" Then
                If SortDirection = "asc" Then
                    If tabfiles(k).type <= tabfiles(j).type Then j = k
                Else
                    If tabfiles(k).type >= tabfiles(j).type Then j = k
                End If
            End If
        Next k
 
        If i <> j Then
            ' on inverse les 2 éléments
            tabfilestemp = tabfiles(j)
            tabfiles(j) = tabfiles(i)
            tabfiles(i) = tabfilestemp
        End If
    Next i
End Sub
' -----------------------------------------------------------------------
' Tester la fonction de recherche
' -----------------------------------------------------------------------
Function test_dir()
    Dim tabfiles() As TypeFileInfo
    Dim nbfile As Long
    Dim i
 
    nbfile = NewFileSearch("D:\Bureautique\Océan\Polices\105665\", "*.doc", "size", "desc", tabfiles)
    Debug.Print "nombre de fichier=" & nbfile
    For i = 1 To nbfile
        Debug.Print "i=" & i
        Debug.Print tabfiles(i).DateCreated
        Debug.Print tabfiles(i).DateLastModified
        Debug.Print tabfiles(i).Size
        Debug.Print tabfiles(i).FileName
        Debug.Print tabfiles(i).type
        Debug.Print tabfiles(i).PathName
        Debug.Print "---------------------------------------"
    Next
End Function

C'est beaucoup plus rapide qu'avant, surtout quand je dois récupérer 2 ou 3 fichiers sur plus de 20 000 dans un seul dossier, c'est presque instantanné.

Par contre si je veux récupérer 100 fichiers contenus dans un seul dossier (qui contient 100 fichiers), j'ai mon résultat en 6-7 secondes, alors qu'avec FileSearch c'était immédiat et quelque soit la puissance du PC.

C'est la boucle Do dir loop qui prend du temps

Je laisse mon code ici, ça pourra en aider certains et on pourra le faire évoluer...

Quelqu'un a une autre idée ?

[Razmote]

Finalement après plusieurs essais, ça marche assez bien et le temps de réponse est de 2 ou 3 secondes dans les mêmes conditions...

Donc problème résolu.