Recherche nom sous dossier

Bonjour,

j ai un fichier s appelant "tom__revA.pdf" se trouvant dans un répertoire "mesdocs". Je souhaiterais trouver le chemin de ce fichier pdf dans tous les sous dossiers et creer un lien dans une cellule envoyant vers ce fichier.

j ai actuellement essayer ce code mais il ne fonctionne pas

Sub Recherche()

chemin = Dir("V:\mesdocs")

Do While chemin <> ""

If chemin <> "tom_revA*" Then

chemin = Dir

Else

MsgBox ("Le fichier n'existe pas")

End If

Loop

End Sub

pourriez vous me dire pourquoi il me renvoie pas le chemin ?

Merci

Bonjour,

Essaies comme ça :

Sub Recherche()
Dim chemin$, fichiers$
  chemin = Dir("V:\mesdocs\tom_revA*")
  Do While chemin <> ""
    fichiers = fichiers & vbCr & "- " & chemin
    chemin = Dir
  Loop
  If fichiers <> "" Then
    MsgBox "Fichiers trouvés : " & fichiers
  Else
    MsgBox ("Aucun fichier trouvé")
  End If
End Sub

Bonjour,

j ai un fichier s appelant "tom__revA.pdf" se trouvant dans un répertoire "mesdocs".

pas bien clair. Pas dans un sous-répertoire de "mesdocs" plutôt ?
eric

Oui c est dans un sous dossier des mesDocs, et je ne sais pas lequel.

Et je souhaiterai retourner le chemin de ce fichier sous une variable.

Lorsque je met a = Dir ca ne marche pas.

Merci

Bonjour,

Pour chercher un (ou des) fichier(s) dans un dossier (et ses sous dossiers) :

' Note : il faut activer la référence (dans Outils > Références ...) à Microsoft Scripting Runtime
'
Option Explicit
Option Private Module

Public Type typScan
  Folder As String
  File As String
  InSubFolders As Boolean
  BinaryCompare As Boolean
  Files As Variant
  Count As Long
End Type

Sub Test()
' test recherche fichiers
Dim scan As typScan

  scan.Folder = "V:\mesdocs"
  scan.File = "tom__revA.pdf"
  scan.InSubFolders = True
'  scan.BinaryCompare = True
  Call RechercheFichiers(scan)
  If scan.Count > 0 Then
    MsgBox scan.Count & " fichier(s) trouvé(s) :" & vbCrLf & "- " & Join(scan.Files, vbCrLf & "- ")
  Else
    MsgBox "Aucun fichier trouvé"
  End If

End Sub

Public Sub RechercheFichiers(scan As typScan)
' Recherche les fichiers
Dim dic As New Dictionary
  Call ChercheFichiers(dic, scan.Folder, scan.File, scan.InSubFolders, scan.BinaryCompare)
  scan.Count = dic.Count
  If dic.Count > 0 Then
    scan.Files = dic.Keys
  End If
End Sub

Private Sub ChercheFichiers(dicFichiers As Dictionary, ByVal strChemin As String, ByVal strFichier As String, _
                            ByVal blnSousDossiers As Boolean, ByVal blnComparaisonBinaire As Boolean)
' Procédure récursive qui liste les fichiers trouvé dans le dossier (et des sous-dossiers)
'
' Arguments : dicFichiers           [in/out]  Chemin du dossier à explorer
'             strChemin             [in]      Chemin du dossier à explorer
'             strFichier            [in]      Nom du fichier à chercher, accepte les caractères génériques.
'             blnSousDossiers       [in]      Vrai = Recherche dans les sous-dossiers
'             blnComparaisonBinaire [in]      Vrai = comparaison binaire (prend en compte la casse)
'
'————————————————————————————————————————————————————————————————————————————————————————————————————————————————
'
Dim objFSO As FileSystemObject         'File System Object
Dim objRep As Scripting.Folder         'Dossier à analyser
Dim objSubRep As Scripting.Folders     'Collection de Sous-dossiers
Dim objSubRepItem As Scripting.Folder  'Sous-dossier
Dim objSubFile As Scripting.Files      'Collection des fichiers du dossier
Dim objSubFileItem As Scripting.File   'Fichier cherché

  On Error Resume Next
  'Explorer le dossier
  Set objFSO = New FileSystemObject
  Set objRep = objFSO.GetFolder(strChemin)                  'dossier
  If blnSousDossiers Then
    Set objSubRep = objRep.SubFolders                       'sous-dossiers
    '- traiter chaque sous-dossier
    For Each objSubRepItem In objSubRep
      ' appel recursif
      Call ChercheFichiers(dicFichiers, objSubRepItem.Path, strFichier, blnSousDossiers, blnComparaisonBinaire)
    Next
  End If
  Set objSubFile = objRep.Files                             'fichiers
  '- traiter chaque fichier
  If strFichier = vbNullString Then strFichier = "*"
  For Each objSubFileItem In objSubFile
    If blnComparaisonBinaire Then
      If objSubFileItem.Name Like strFichier Then dicFichiers(objSubFileItem.Path) = ""
    Else
      If LCase(objSubFileItem.Name) Like LCase(strFichier) Then dicFichiers(objSubFileItem.Path) = ""
    End If
  Next
  Set objFSO = Nothing
  Set objRep = Nothing
  Set objSubRep = Nothing
  Set objSubRepItem = Nothing
  Set objSubFile = Nothing
  Set objSubFileItem = Nothing

End Sub

Bonjour

Ce code me parait très bien. Cependant, il me dit que l'option private module n'est pas possible dans un objet. Sauriez vous pourquoi ?

Merci

Parce qu'il faut mettre ce code dans un module standard, pas dans un module de classe (objet perso ou objet Excel feuille ou classeur)