Discussion :

[fergal]

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 :

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
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

[casefayere]

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 :

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
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 :

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
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

[kiki29]

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

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
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

[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.