OVH Cloud OVH Cloud

Cherche fichier

11 réponses
Avatar
Jacky
Bonjour à tous,

Comment en vba trouver un fichier sur plusieurs disques et répertoires, mais
en ne connaissant que son nom ou une partie de son nom ??

Merci

1 réponse

1 2
Avatar
Jacky
Bonjour Pascal

Avec l'info de Denis j'ai pu faire fonctionner ton code, c'est exactement ce
que je voulais faire.
Je vais le décortiquer pour essayer de le comprendre, car dans ce domaine
précis, je n'ai pas beaucoup d'expérience.
Merci beaucoup

Salutations
JJ

"papou" <nspm> a écrit dans le message news:

Oups !!
Dans la procédure nommée Recherche, tu peux supprimer les 2 lignes
suivantes

:
Dim I As Integer
I = 0
Cordialement

Pascal

"papou" <nspm> a écrit dans le message de
news:eR$
Bonjour Jacky
Effectivement ce n'est pas hyper efficace.
Dans ces conditions je te propose d'utiliser le FileSystemObject.
De cette façon, on peut également retrouver le nombre de lecteurs
présents.

Voici donc un exemple qui va lister sur la feuille active tous les
fichiers

trouvés sur les lecteurs fixes
(Il faut lancer VaChercher)
Cordialement
Pascal

Dim Lecteur As Scripting.Drive
Dim FSO As Scripting.FileSystemObject
'Ajouter une référence à Microsoft Scripting RunTime
'(C:WINNTSYSTEM32scrrun.dll sur W2000)
Sub VaChercher()
Dim Rep As Scripting.Folder
Dim Emplacement As String
Dim LeFichier As String
LeFichier = "Class*.xls"
Dim L As Integer
Set FSO = New Scripting.FileSystemObject
L = 0
For Each Lecteur In FSO.Drives
If Lecteur.DriveType = Fixed Then
L = L + 1
Emplacement = Lecteur & ""
ActiveSheet.Cells(1, L).Value = "Fichiers nommés " & LeFichier &
"


trouvés sur " & Emplacement
Recherche LeFichier, Emplacement, L, True
End If
Next Lecteur
Set FSO = Nothing
End Sub
Sub Recherche(NomduFichier As String, NomduRepertoire As String, L As
Integer, SousDossier As Boolean)
Dim LeRepertoire As Scripting.Folder
Dim SousRep As Scripting.Folder
Dim Fichier As Scripting.File
Dim I As Integer
I = 0
Set FSO = New Scripting.FileSystemObject
Set LeRepertoire = FSO.GetFolder(NomduRepertoire)
For Each Fichier In LeRepertoire.Files
If Fichier.Name Like NomduFichier Then
r = ActiveSheet.Cells(65536, L).End(xlUp).Row + 1
ActiveSheet.Cells(r, L).Value = Fichier.Path
End If
Next Fichier
ActiveSheet.Columns(L).EntireColumn.AutoFit
If SousDossier Then
For Each SousRep In LeRepertoire.SubFolders
Recherche NomduFichier, SousRep.Path, L, True
Next SousRep
End If

Set Fichier = Nothing
Set SousRep = Nothing
Set FSO = Nothing
End Sub



"Jacky" a écrit dans le message de
news:OVku5$
Bonjour et merci Pascal

J'ai en retour d'une recherche avec< LesDisques = Array("C:", "D:")>
et.


<Filename = "*.xls">
Erreur d'execution 9
Index en dehors de la plage
Et bloque sur <Emplacement = LesDisques(NbDisques)>

Ces 2 disques existent.(6 au total sur mon pc)
Bien qu'il trouve un certain nombre de fichiers, la liste et loin
d'être



complète.
Ne peut-on pas faire rechercher le nombre de disque présent ??

Cordialement
JJ


"papou" <nspm> a écrit dans le message de news:

Bonjour Jacky
Voici un exemple à adapter (Tableau LesDisques et nom du fichier à
remplacer

ici = "Class*.xls")
Les fichiers trouvés sont listés sur la feuille active
Cordialement
Pascal

Sub VaChercher()
Dim LesDisques As Variant, Emplacement As String
LesDisques = Array("C:", "D:")
Set fs = Application.FileSearch
With fs
For NbDisques = 1 To 2
Emplacement = LesDisques(NbDisques)
.LookIn = Emplacement
.Filename = "Class*.xls"
.SearchSubFolders = True
If .Execute > 0 Then
ActiveSheet.Cells(1, NbDisques).Value = .FoundFiles.Count &
_




" fichier(s) trouvé(s) sur " & Emplacement
For i = 1 To .FoundFiles.Count
ActiveSheet.Cells(i + 1, NbDisques).Value .FoundFiles(i)
Next i
Else
MsgBox "Aucun fichier trouvé sur " & Emplacement
End If
Next
End With
End Sub

"Jacky" a écrit dans le message de
news:
Bonjour à tous,

Comment en vba trouver un fichier sur plusieurs disques et
répertoires,



mais
en ne connaissant que son nom ou une partie de son nom ??

Merci




















1 2