recherche de fichier à partir d'excel Fermé

Question

Bonjour,
j'ai des fichiers qui sont rangé dans un dossier qui est décomposé en autres sous dossiers etc et en dernier rang on trouve ces fichiers. je souhaiterais me créer une petite application sous excel employant les liens hypertexte de telle facons que lorsque je tape le numéro du fichier que je souhaite obtenir celui ci s'ouvre automatiquement.
il faudrait que cette petite application retrouve le fichier uniquement a partir du dossier principal (car tout les sous dossier ont des noms différents donc difficile a mettre en ouevre une forme de pré tri)
est ce que c'est possible de faire ce genre de chose ou faut il que j'arrète de rêver???

pijaku · Answer

J'ai trouvé ici un code que j'ai adapté...:

Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String
Dim Nbr As Long
Dim I As Long
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = "E:\Utilisateurs\gnagnagna\etc etc"
.SearchSubFolders = True
.Filename = "xls"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
I = 0
For Each NomFic In .FoundFiles
I = I + 1
Sheets("Feuil1").Cells(I, 1).Select
ActiveCell = I
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=NomFic
Next
End With

pijaku · Answer

Alors pas de souci.
Le plus simple est un "CommandButton".
Tu ouvres un classeur Excel.
Tu l'enregistres (par exemple recherche fichiers.xls)
Tu va dans Affichage/Barre d'outils/Barre d'outils contrôles. Tu coches cette option (si ce n'est pas déjà fait).
Dans cette barre d'outils, tu cherches l'icône correspondante à "Bouton de Commande" (petit rectangle gris)
Tu cliques dessus et dessines ton propre bouton dans la feuille Feuil1 de ton classeur Excel.
Double clic sur ce bouton et apparait la fenêtre VBE avec dedans :

Private Sub CommandButton1_Click()

End Sub

Entre ces deux lignes, tu fais un copier / coller de ce code en adaptant les parties grasses :

Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String
Dim Nbr As Long, I As Long
Dim prem As Integer, dern As Integer
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = "C:\Utilisateurs\gnagnagna\Mes documents\TRAVAIL\gnagnagna" '--->ici tu remplaces par le chemin de ton dossier
.SearchSubFolders = True
.Filename = "*.*" '---> affiche tous les fichiers de tous les sous dossiers du dossier choisi. Tu peux remplacer par xls, ppt ou doc etc....
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
I = 0
For Each NomFic In .FoundFiles
prem = Len(NomFic)
dern = Len("C:\Utilisateurs\gnagnagna\Mes documents\TRAVAIL\gnagnagna") '--->recopie exactement le chemin que tu as indiqué plus haut
fich = Right(NomFic, prem - dern - 1)
I = I + 1
Sheets("Feuil1").Cells(I, 1).Select
ActiveCell = I
Sheets("Feuil1").Cells(I, 2).Select
ActiveCell = fich
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=NomFic
Next
End With
Columns("A:B").EntireColumn.AutoFit

pour obtenir ceci :

Private Sub CommandButton1_Click()

ici tout le code...

End Sub

 Ensuite, tu fermes cette fenêtre VBE et cliques sur l'icône "Désactiver le mode création" (première à gauche normalement).
Et cliques sur ton bouton

pijaku · Answer

Je vais voir ce que je peux faire... De retour dans 5 minutes...

pijaku · Answer

Voilà : Tu écris ton nom de fichier en A2 avec l'extension (ex : classeur1.xls) et tu cliques

Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, exten As String
Dim Nbr As Long, I As Long
Dim prem As Integer, dern As Integer
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = "C:\Utilisateurs\gnagna\Mes documents\TRAVAIL\blablabla"
.SearchSubFolders = True
.Filename = exten
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
I = 1
For Each NomFic In .FoundFiles
prem = Len(NomFic)
dern = Len("C:\Utilisateurs\gnagna\Mes documents\TRAVAIL\blablabla")
fich = Right(NomFic, prem - dern - 1)
If fich = Range("A2").Value Then
Range("A3").Select
ActiveCell = fich
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=NomFic
Else
I = I + 1
End If
Next
End With
Columns("A:B").EntireColumn.AutoFit

A placer entre : Private Sub CommandButton2_Click()  et  End sub

pijaku · Answer

Non c'est ma faute.
Voici le code pour rechercher des fichiers excel :

Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, exten As String
Dim Nbr As Long, I As Long
Dim prem As Integer, dern As Integer
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = "C:\Utilisateurs\gnagna\Mes documents\TRAVAIL\blablabla"
.SearchSubFolders = True
.Filename = "xls"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
I = 1
For Each NomFic In .FoundFiles
prem = Len(NomFic)
dern = Len("C:\Utilisateurs\gnagna\Mes documents\TRAVAIL\blablabla")
fich = Right(NomFic, prem - dern - 1)
If fich = Range("A2").Value Then
Range("A3").Select
ActiveCell = fich
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=NomFic
Else
I = I + 1
End If
Next
End With
Columns("A:B").EntireColumn.AutoFit

tompols · Answer

Bonjour,
j'ai quelque peu modifié le code de pijaku, cela devrais maintenant fonctionner (reste à le faire sur toute la feuille ou créer une fonction,mais là je laisse la main, jdois filer....) : 
Dim ScanFic As Office.FileSearch
Dim Nbr As Long
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.Filename = Range("A2").Value
.LookIn = "C:\Utilisateurs\gnagna\Mes documents\TRAVAIL\blablabla"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
Nbr = .Execute
End With
If Nbr = o Then
    Range("A3").Value = "Aucun fichier trouvé"
    Exit Sub
ElseIf Nbr > 1 Then
    Range("A3").Value = "Plusieurs fichiers trouvés"
    Exit Sub
End If 
For Each f In ScanFic.FoundFiles
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A3"), Address:=f, TextToDisplay:=f
Next f

pijaku · Answer

Salut,
 Je reprends en route...
Plusieurs fichiers trouvés et rien ne s'affiche... Normal tu as mis ce code (sortir de la macro si plusieurs fichiers trouvés...) :

ElseIf Nbr > 1 Then
    Range("A3").Value = "Plusieurs fichiers trouvés"
Exit Sub
End If

J'ai retravaillé sur la base de tompols et ça donne :

Dim ScanFic As Office.FileSearch
Dim Nbr As Long
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.Filename = Range("A2").Value
.LookIn = "C:\Utilisateurs\gnagna\Mes documents\TRAVAIL\blablabla"
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
End With
If Nbr = o Then
    Range("A3").Value = "Aucun fichier trouvé"
    Exit Sub
ElseIf Nbr > 1 Then
    Range("A3").Value = "Plusieurs fichiers trouvés"
End If
ActiveSheet.Range("A3").Select
For Each f In ScanFic.FoundFiles
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=f, TextToDisplay:=f
Next f

Cette fois ci c'est la bonne!!!!

pijaku · Answer

Avec ceci une glace vanille un milkShake banane et une boisson fraiche???

Je plaisante.
Pour l'effacement ajoute ceci :
Range("A3:A10").ClearContents
après : 
Nbr = .Execute
End With

Recherche de fichier à partir d'excel

8 réponses

Discussions similaires