Recherche fichier sur hdd

re,

avec l'avis des collègues internet, une 2ième possibilité.

Le premier fichier s'ouvre si la suffixe est admis (c'est dangereux d'ouvrir n'importe quel fichier) ou si l'on double-clicque sur une cellule de la colonne D-E

Bonjour Bsalv

Tes code fonctionne bien sur mon pc chez moi mais par contre pas compatible au taf (surement du blocage par le service informatique)

Bonjour Bruno

j'ai passé un moment a tester ton code pour trouver le moyen d’arrêter du moulinage et je l'ai enfin trouvé

je mets donc le code complet ici :

' Flag à vrai si fichier trouvé
Dim FlgOk As Boolean

Sub Test()
  Dim sPath As String, sCrit As String, sExt As String
  ' Initialiser les variables
  sPath = Range("B1").Value 'ou metre le chemin directement dans le code
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
  sCrit = Range("B2").Value 'dans un liste déroulante sur la feuille
  sExt = ".jpg"
  ' Mettre le flag à FAUX
  FlgOk = False
  ' Appeler la procédure
  Call OuvrirTousLesFichiers(sPath, sCrit, sExt)
  ' Vérifier le flag
  If FlgOk = False Then
    MsgBox "Pas de fichier trouvé", vbCritical, "oups..."
  End If
End Sub

' Nécessite d'activer la référence "Microsoft Scripting RunTime"
Sub OuvrirTousLesFichiers(sPath As String, sCrit As String, sExt As String)
  Dim ShellApp As Object
  Dim Fso As Scripting.FileSystemObject
  Dim SourceFolder As Scripting.Folder
  Dim SubFolder As Scripting.Folder
  Dim FileItem As Scripting.File
  ' Créer une instance
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = Fso.GetFolder(sPath)
  Set ShellApp = CreateObject("Shell.Application")
  'Boucle sur tous les fichiers du répertoire
  For Each FileItem In SourceFolder.Files
    If FlgOk Then Exit Sub
    ' On met en majuscule pour éviter problème de casse
    If UCase(FileItem.Name) Like "*" & UCase(sCrit) & "*" & UCase(sExt) Then
      ShellApp.Open (FileItem.ParentFolder & "\" & FileItem.Name)
      ' Au moins 1 fichier trouvé, on met le flag à VRAI
      FlgOk = True

    End If
  Next FileItem
  '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
  For Each SubFolder In SourceFolder.subfolders
      OuvrirTousLesFichiers SubFolder.Path, sCrit, sExt
      If FlgOk = True Then exitfor 'si un fichier trouvé , on sort de la boucle (supprime bien le "moulinage")
  Next SubFolder
End Sub

Merci bien Bruno pour toute l'aide apportée

Merci aussi à Bslav ;)

Bonjour Ledoc

Heureux que tu es pu trouver enfin la solution