Discussion :

[Max0o]

Bonjour,

Je travaille actuellement sur office 2010 en utilisant un code qui fonctionnait sous office 2003.
J'ai fait quelques recherches et il semblerait que la fonction FileSearch n'existe pas sur les versions supérieur à office 2003.

Je cherche donc un moyen de faire fonctionner ce code:

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
Sub PeuplerImages(str As String)
    Dim strtmp As String
    Dim fs As Object
    Dim i As Integer
    Set fs = Application.FileSearch
    While ChoixImage.ListImage.ListCount > 0
    ChoixImage.ListImage.RemoveItem 0
    Wend
 
    With fs
        .LookIn = str
        .filename = "*.jpg"
        .FileType = msoFileTypeAllFiles
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                strtmp = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(repImage) - 1)
                ChoixImage.ListImage.AddItem (strtmp)
            Next i
        Else
        repImage = GetImageLibOfflinePath()
        str = GetImageLibOfflinePath()
        .LookIn = str
        .filename = "*.jpg"
        .FileType = msoFileTypeAllFiles
       If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                strtmp = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(repImage) - 1)
                ChoixImage.ListImage.AddItem (strtmp)
            Next i
        Else
            MsgBox "Pas d'image trouvée."
        End If
        End If
    End With
 
End Sub

Merci d'avance.

Max0o

[Invité]

Bonjour

A lire : Un complément FileSearch pour Excel 2007

Philippe

[Max0o]

Bonjour,

En recherchant un peu j'etais tombé sur cet article, mais je dois utilisé cette fonction sur PowerPoint,Word et Excel, es ce possible juste avec le complément Excel ?
Je dois ensuite diffusé ce code sur environ 1 000 postes, es ce qu'il faut installer le complément sur chaque postes ?

Sinon, n'y a t'il pas une autre solution pour contourner cette fonction ?

Merci d'avance

Maxime

[erwanou]

Il existe aussi une alternative à la fonction filesearch en passant par les API microsoft

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
Option Explicit
 
'#################################################
'##                                             ##
'## remplacement de la fonction filesearch      ##
'#################################################
 
'---------------------------------------------------
'------Déclarations propres aux API Find File ------
'---------------------------------------------------
'---Les constantes---
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
 
'---Les API---
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
         (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
         (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'---Les types---
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
'------------------------------------------------------------
'------Déclarations propres à la fonction de recherche ------
'------------------------------------------------------------
Private Type ListeFichier
    Fichiers() As WIN32_FIND_DATA
    Chemin() As String * MAX_PATH
    Nombre As Long
End Type
 
--------------------------------------------------------------------------------------------------------------------------------
 
'------------------------------------------------------------
'------ fonction de recherche ------
'------------------------------------------------------------
 
Private Function Rechercher(Chemin As String, FichierR As String, _
        ResultatRecherche As ListeFichier) As Long
'---Déclaration des variables---
Dim lpFindFileData As WIN32_FIND_DATA
Dim hFindFile As Long
Dim lgRep As Long
Dim CheminRep As String
'---Recherche tous les fichiers demandés dans le répertoire Chemin---
hFindFile = FindFirstFile(Chemin & FichierR, lpFindFileData)
If hFindFile <> INVALID_HANDLE_VALUE Then
    Do
        ' Mémorise
        ResultatRecherche.Nombre = ResultatRecherche.Nombre + 1
        ReDim Preserve ResultatRecherche.Chemin(1 To ResultatRecherche.Nombre)
        ReDim Preserve ResultatRecherche.Fichiers(1 To ResultatRecherche.Nombre)
        ResultatRecherche.Chemin(ResultatRecherche.Nombre) = Chemin
        ResultatRecherche.Fichiers(ResultatRecherche.Nombre) = lpFindFileData
        ' Initialise lpFindFileData (Variable texte uniquement)
        lpFindFileData.cAlternate = String$(14, 0)
        lpFindFileData.cFileName = String$(MAX_PATH, 0)
    Loop Until FindNextFile(hFindFile, lpFindFileData) = 0
End If
FindClose hFindFile
'---Recherche dans les sous-répertoires---
hFindFile = FindFirstFile(Chemin & "*.*", lpFindFileData)
If (hFindFile <> INVALID_HANDLE_VALUE) Then
    Do
        ' Si c'est un répertoire on continu le recherche
        If (lpFindFileData.dwFileAttributes And _
            FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            ' Extraction du nom du répertoire
            CheminRep = Mid$(lpFindFileData.cFileName, 1, _
                        InStr(1, lpFindFileData.cFileName, Chr$(0)) - 1)
            ' Attention dans les sous-répertoire aux
            ' répertoires . et .. (Retour répertoire parent)
            If (CheminRep <> ".") And (CheminRep <> "..") Then
                CheminRep = Chemin & CheminRep & "\"
                Rechercher = Rechercher(CheminRep, FichierR, ResultatRecherche)
            End If
        End If
    Loop Until FindNextFile(hFindFile, lpFindFileData) = 0
End If
FindClose hFindFile
'---Retourne le nombre d'occurrences trouvées---
Rechercher = ResultatRecherche.Nombre
End Function
 
 
 
'---------------------------------------------------------------
'------ exemple d'utilisation de la fonction de recherche ------
'---------------------------------------------------------------
 
NbFichiers = Rechercher(p_Fiches, "*.xlsm", ResultatRecherche)
    For i = 1 To NbFichiers
 
 
        Nom_fichier_Actif = Trim$(ResultatRecherche.Chemin(i)) & Trim$(ResultatRecherche.Fichiers(i).cFileName)