Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Cherche fichier

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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
papou
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




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








Avatar
gb
Bonjour.
J'ai l'impression que la syntaxe .LookIn = Emplacement ne change pas la
valeur de la propriété .LookIn.
Il faut obligatoirement utiliser cette syntaxe hard : .LookIn = "C:"
ce qui n'est pas très pratique car cela ne permet pas de modifier la valeur
de .LookIn en cours de traitement.
C'est du moins le cas sur Windows 98SE.

"papou" <nspm> a écrit
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








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












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
















Avatar
Jacky
Rebonjour Pascal

Je suis pas sûr d'avoir tout compris:

Dim Lecteur As Scripting.Drive
Dim FSO As Scripting.FileSystemObject
'Ajouter une référence à Microsoft Scripting RunTime
'(C:WINNTSYSTEM32scrrun.dll sur W2000)
Ca je sais pas faire.
Je suis sous winNT, Excel 97 SR2 ou win 98se Excel 97
J'ai une erreur de < type non défini par l'utilisateur > sur <Dim Rep As
Scripting.Folder>
Peux-tu me donner quelques explications ?
Excuse mon ignorance

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




















Avatar
gb
Voici une façon rapide de chercher les fichiers contenant un mot.

Declare Function GetLogicalDriveStrings Lib _
"kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Dim Fichiers As Collection
Dim Lecteurs() As String

'Rechercher dans tous les lecteurs les fichiers dont le nom contient un mot
Private Sub ChercherlesFichiersContenant()

Dim MotAChercher As String

MotAChercher = ".xls"

Cells.ClearContents

Call ListeDesLecteurs


For intLecteur = 0 To UBound(Lecteurs)
colonne = intLecteur + 1
ligne = 1
Cells(ligne, colonne).Value = Lecteurs(intLecteur)

Set Fichiers = New Collection

Call DirRep(Lecteurs(intLecteur), MotAChercher)

For intFichier = 1 To Fichiers.Count
ligne = ligne + 1
Cells(ligne, colonne).Value = Fichiers.Item(intFichier)
Next intFichier

Set Fichiers = Nothing

Next intLecteur

End Sub
Private Sub DirRep(NomRep As String, strContenu As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer

If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
On Error Resume Next
strContenu = UCase(strContenu)
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
If InStr(UCase(NomFic), strContenu) > 0 Then
'If UCase(Right$(NomFic, 4)) = UCase(strContenu) Then
Fichiers.Add NomRep & NomFic
End If
End If


NomFic = Dir
Wend

' Appel récursif de la même fonction pour traiter les dossiers
While Dossiers.Count > 0
DirRep Dossiers(1), strContenu
Dossiers.Remove 1
Wend


End Sub


Sub ListeDesLecteurs()
Dim Buffer As String * 255
Dim BuffLen As Long

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)
TheString = Left(Buffer, BuffLen)
TheDrive = ""
DriveCount = -1

' Créer un tableau des lecteurs
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) <> 0 Then _
TheDrive = TheDrive & Mid(Buffer, i, 1)
If Asc(Mid(Buffer, i, 1)) = 0 Then
DriveCount = DriveCount + 1
ReDim Preserve Lecteurs(DriveCount)
Lecteurs(DriveCount) = UCase(TheDrive)
TheDrive = ""
End If
Next i

End Sub
Avatar
Denis Michon
Bonjour Jacky,


Pour ceux qui n'ont pas une version récente d'internet Explorer d'installer, tu ouvres VBE (visual basic editor) de
l'application excel, et à partir de la barre des menus / outils / références / dans la fenêtre, coche l'item :
"Microsoft Scripting Runtime" .


Salutations!



"Jacky" a écrit dans le message de news:
Rebonjour Pascal

Je suis pas sûr d'avoir tout compris:

Dim Lecteur As Scripting.Drive
Dim FSO As Scripting.FileSystemObject
'Ajouter une référence à Microsoft Scripting RunTime
'(C:WINNTSYSTEM32scrrun.dll sur W2000)
Ca je sais pas faire.
Je suis sous winNT, Excel 97 SR2 ou win 98se Excel 97
J'ai une erreur de < type non défini par l'utilisateur > sur <Dim Rep As
Scripting.Folder>
Peux-tu me donner quelques explications ?
Excuse mon ignorance

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




















Avatar
Jacky
Bonjour Denis

Merci pour l'information.
Les codes de Pascal fonctionnent mieux avec cet item de coché

Salutations
JJ

"Denis Michon" a écrit dans le message news:
oBbqb.9679$
Bonjour Jacky,


Pour ceux qui n'ont pas une version récente d'internet Explorer
d'installer, tu ouvres VBE (visual basic editor) de

l'application excel, et à partir de la barre des menus / outils /
références / dans la fenêtre, coche l'item :

"Microsoft Scripting Runtime" .


Salutations!



"Jacky" a écrit dans le message de
news:

Rebonjour Pascal

Je suis pas sûr d'avoir tout compris:

Dim Lecteur As Scripting.Drive
Dim FSO As Scripting.FileSystemObject
'Ajouter une référence à Microsoft Scripting RunTime
'(C:WINNTSYSTEM32scrrun.dll sur W2000)
Ca je sais pas faire.
Je suis sous winNT, Excel 97 SR2 ou win 98se Excel 97
J'ai une erreur de < type non défini par l'utilisateur > sur <Dim Rep As
Scripting.Folder>
Peux-tu me donner quelques explications ?
Excuse mon ignorance

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

























Avatar
Jacky
Merci GB
Je vais essayer ton code, il me faudra quelque temps pour le comprendre dans
sa totalité.
Salutations,
JJ

"gb" a écrit dans le message news:
ekQ#
Voici une façon rapide de chercher les fichiers contenant un mot.

Declare Function GetLogicalDriveStrings Lib _
"kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Dim Fichiers As Collection
Dim Lecteurs() As String

'Rechercher dans tous les lecteurs les fichiers dont le nom contient un
mot

Private Sub ChercherlesFichiersContenant()

Dim MotAChercher As String

MotAChercher = ".xls"

Cells.ClearContents

Call ListeDesLecteurs


For intLecteur = 0 To UBound(Lecteurs)
colonne = intLecteur + 1
ligne = 1
Cells(ligne, colonne).Value = Lecteurs(intLecteur)

Set Fichiers = New Collection

Call DirRep(Lecteurs(intLecteur), MotAChercher)

For intFichier = 1 To Fichiers.Count
ligne = ligne + 1
Cells(ligne, colonne).Value = Fichiers.Item(intFichier)
Next intFichier

Set Fichiers = Nothing

Next intLecteur

End Sub
Private Sub DirRep(NomRep As String, strContenu As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer

If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
On Error Resume Next
strContenu = UCase(strContenu)
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
If InStr(UCase(NomFic), strContenu) > 0 Then
'If UCase(Right$(NomFic, 4)) = UCase(strContenu) Then
Fichiers.Add NomRep & NomFic
End If
End If


NomFic = Dir
Wend

' Appel récursif de la même fonction pour traiter les dossiers
While Dossiers.Count > 0
DirRep Dossiers(1), strContenu
Dossiers.Remove 1
Wend


End Sub


Sub ListeDesLecteurs()
Dim Buffer As String * 255
Dim BuffLen As Long

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)
TheString = Left(Buffer, BuffLen)
TheDrive = ""
DriveCount = -1

' Créer un tableau des lecteurs
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) <> 0 Then _
TheDrive = TheDrive & Mid(Buffer, i, 1)
If Asc(Mid(Buffer, i, 1)) = 0 Then
DriveCount = DriveCount + 1
ReDim Preserve Lecteurs(DriveCount)
Lecteurs(DriveCount) = UCase(TheDrive)
TheDrive = ""
End If
Next i

End Sub








1 2