[VBA] Filesearch - Code de substitution ?

Version imprimable

Bonjour à tous.

J'ai trouvé un code qui m'intéresse beaucoup. (Voir en fin de post pour l'exemple.)
Cependant la fonction .filesearch n'est plus disponible dans excel 2007.

La réponse est peut-être déjà sur le forum mais quelque soit les mots clef rentrés, je ne trouve rien.
Les seuls exemples que je trouve sont des " listage" de fichiers présents dans un répertoire.
( http://silkyroad.developpez.com/vba/classefilesearch/)

Y a-t-il une possibilité d'ouvrir directement le fichier ?

Sachant que la version d'excel est installée sur un serveur d'entreprise en multi-licence et que les droits administrateur sont verrouillés. Donc impossibilité de rajouter le fichier ClasseFileSearch.xla dans le dossier Addins.

Dans le même répertoire, il y a environ 700 fichiers du même type.
1 code alphanumérique à 5 chiffres - Nom client.xls

03252 - Machin.xls etc...

Plutôt que de perdre du temps à ouvrir le répertoire et à chercher (La manipulation peut être faite jusqu'à 80 fois voire plus par jour), je souhaiterais juste taper le code client dans la fenêtre de dialogue et valider pour ouvrir.

Est-ce définitivement infaisable dans Excel 2007 ?

Merci d'avance pour vos réponses.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub test() Dim nom As String 'déclare la variable nom dim noncomplet as string 'déclare la variable nomcomplet Dim chem As String 'déclare la variable chem nom = InputBox("Nom du classeur") 'définit la variable nom (début du nom du fichier) chem = ActiveWorkbook.Path 'définit la variable chem (chemin d'accès du classeur actuel, à adapter) With Application.FileSearch 'recherche de fichier .LookIn = chem 'dans le même répertoire que le fichier actuel .SearchSubFolders = True 'dans les sous-répertoires .Filename = nom & "*.xls" 'tous les fichiers Excel commençant par le nom de la boite If .Execute > 0 Then 'si au moins un fichier est trouvé nomcomplet = .FoundFiles(1) 'définit le nom complet du fichier trouvé Workbooks.Open (nomcomplet) 'ouvre le fichier End If End With End Sub

Bonsoir,
sans clfilesearch, je pense qu'il faut passer par FSO, lis bien ce lien
et tu devrais pouvoir te débrouiller, en glanant des info sur DVP

http://msdn.microsoft.com/fr-fr/vbasic/bb892763#eeg

Bon travail

J'ai préparé un code pour toi que tu pouras adapter. J'ai mis le résultat de la recherche dans un msgbox mais si tu veux ouvrir le fichier trouvé, je te conseille une listbox, je mets d'ailleurs, (je réfléchis en écrivant) les deux solutions :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Option Compare Text
Sub Cherche()
   Dim fso, f, f1, fc, s
   Dim nomfichier As String
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(ThisWorkbook.Path)
   Set fc = f.Files
   nomfichier = InputBox("elements de recherche")
   For Each f1 In fc
     If f1 Like "*" & nomfichier & "*" Then
         s = s & f1.Name & " " & f1.DateCreated 'la tu ajoutes ce que tu veux
         s = s & vbCrLf
     End If
   Next
   MsgBox s
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Option Compare Text
Sub Cherche()
   Dim fso, f, f1, fc, s
   Dim nomfichier As String
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(ThisWorkbook.Path)
   Set fc = f.Files
   Sheets("feuil1").ListBox1.Clear
   nomfichier = InputBox("elements de recherche")
   For Each f1 In fc
   If f1 Like "*" & nomfichier & "*" Then
      Sheets("feuil1").ListBox1.AddItem f1
   End If
   Next
End Sub

Salut,une autre récursive ou pas, avec création de liens hypertextes

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
Option Explicit
 
Dim r As Long
Const TypeFichier As String = "xls"
 
Private Sub ListeFichiersDansDossier(sChemin As String, bInclureSousDossiers As Boolean)
Dim FSO As Object, Dossier As Object, Fichier As String
Dim sPath As String
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(sChemin)
 
    Fichier = Dir$(sChemin & "\*.*")
    Do While Len(Fichier) > 0
        sPath = sChemin & "\" & Fichier
        If UCase(TypeFichier) = UCase(FSO.GetExtensionName(Fichier)) Then
            r = r + 1
            ShFichiers.Hyperlinks.Add Anchor:=ShFichiers.Range("A" & r), _
                                      Address:=sPath, TextToDisplay:=CStr(Fichier)
        End If
        Fichier = Dir$()
    Loop
 
    If bInclureSousDossiers Then
        For Each Dossier In Dossier.SubFolders
            ListeFichiersDansDossier Dossier.Path, True
        Next Dossier
    End If
 
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub
 
Sub SelDossier()
Dim sChemin As String
 
    sChemin = ThisWorkbook.Path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Dossier à traiter"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            DoEvents
            Application.ScreenUpdating = False
 
            ShFichiers.Cells.Clear
            r = 0
            ListeFichiersDansDossier .SelectedItems(1), False
            Application.ScreenUpdating = True
        End If
        ShFichiers.Range("E1").Select
    End With
End Sub

05/03/2011, 13h02
fergal

Merci à vous deux,

Pour l'instant je n'ai testé que la "version 2" de casefayere.

En ajoutant l'extraction de la valeur sélectionnée de la listbox en hypertexte pour ouvrir le fichier. Cela fonctionne bien.

Ce qui me permet également de vérifier que le client n'existe bel et bien pas et d'intégrer à cette feuille, un bouton d'ouverture pour la création de sa fiche.

Kiki 29, je n'ai pas eu le temps de tester ton code, je le ferai dans la soirée et te tiens au courant.

Merci à vous deux, et bon week-end.