FileSearch sur Excel 2007
Bonjour à tous ! Je vous présente rapidement mon cas : je suis seconde année de DUT informatique. Pour valider mon diplôme, je termine l'année par un stage. On me demande de reprendre un programme VBA pour Excel. La 1ère version était codée pour Excel 2002 et 2003, et je dois l'adapter pour 2007.
Jusqu'à maintenant, je n'ai rencontré aucun souci de compatibilité et tout marche correctement. Sauf que voilà, il fallait que ça arrive, j'ai (enfin ?) une erreur entre les versions : la fonction FileSearch des anciennes versions ne fonctionne plus sur 2007.
J'ai cherché sur internet des solutions, et j'ai trouvé ceci :
Citation:
File Search ne fonctionne plus sous excel 2007. Voici une solution de contournement pour récupérer la liste des fichiers contenus dans un dossier
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
| Public Function getDir(path As String, sortie As String) As Variant
Dim fList() As String
Dim iPosition As Long
Dim iSize As Long
Dim sFile As String
Dim fRange As Excel.Range
Const iIncrement As Long = 50
iSize = iIncrement
ReDim fList(1 To iSize)
'vous pouvez indiquer *.* pour obtenir la liste de tous les fichiers ou filtrer par l'extension
sFile = Dir(path & IIf(Right(path, 1) = "", "", "") & "*.xls")
Do While Len(sFile)
iPosition = iPosition + 1
If iPosition > iSize Then
iSize = iSize + iIncrement
ReDim Preserve fList(1 To iSize)
End If
fList(iPosition) = sFile
sFile = Dir
Loop
If iSize > iPosition Then
ReDim Preserve fList(1 To iPosition)
End If
Set fRange = Range(sortie).Resize(iPosition, 1)
fRange.Value = WorksheetFunction.Transpose(fList)
fRange.Sort key1:=fRange.Cells(1), order1:=xlAscending
getDir = fRange.Value
End Function |
pour utiliser cette fonction depuis une macro, en utilisant l'adresse du répertoire située en A1 et pour restituer la liste des fichiers dans en E1, E2 ...
Code:
1
2
3
4
| Public Sub FileSearch2007()
Dim v As Variant
v = getDir(Feuil1.Cells(1, 1), "E1")
end sub |
Si tu as besoin en plus de lister les sous répertoires utilise plutôt cette macro :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
| Public Ligne As Long
Sub RechercheFichiers()
Ligne = 0
racine = "e:\donnees\daniel\mpfe" 'Mets ici ton dossier pricipal
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub
Sub Lit_dossier(ByRef dossier)
For Each d In dossier.SubFolders
Lit_dossier d
Next
For Each f In dossier.Files
Ligne = Ligne + 1
ActiveSheet.Hyperlinks.Add Cells(Ligne, 1), f.Path,
TextToDisplay:=f.Name
'Cells(Ligne, 1) = f.Path
Next
End Sub |
La solution me parait bien compliquée par rapport au code de mon employeur...qui elle, tient en 3 lignes :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
| Set fs = Application.FileSearch
With fs
.MatchTextExactly = True
.Filename = nomcherche
If .Execute > 0 Then
MsgBox "Ce nom existe déjà " & .FoundFiles.Count & _
" fiche(s) trouvée."
For i = 1 To .FoundFiles.Count
' MsgBox .FoundFiles(i)
Next i
Else
' MsgBox "Création " & nomcherche
' on crée maintenant la fiche technique
chemin_ftm = chemindonnees + "0FICHE TECHNIQUE MODELE.xls"
Workbooks.Open Filename:=chemin_ftm
Range("F2").Select
ActiveCell = nomfiche
Range("f5").Select
Etc... |
A la place du "etc", on a la suite du "remplissage" de la table, donc rien ne change ici selon les versions, c'est pas le problème.
Je n'arrive pas trop à voir la ressemblance entre la solution trouvée sur le net et le code de mon employeur. Je voudrais donc savoir s'il existe une fonction de recherche toute bête dans Excel 2007 pour éviter d'avoir à créer cinquante mille fonctions supplémentaires. Je souhaiterais une fonction qui fait une simple recherche par nom de fichier dans un seul et même dossier (toutes les fiches techniques sont sauvegardées dans le même dossier, il n'y a pas de sous dossier, d'autre dossier, etc...).
Je vous remercie d'avance pour vos solutions.
