Recherche fichier sur hdd

bonjour,

retour au niveau des codes avec des commentaires et mes craintes concernant ce "/". Ma faute dans ma première reaction, c'étaient ces espaces dans le nom du directory qui n'étaient pas traité d'une bonne manière. J'éspère que Ledoc préfère un code fonctionel comme ici dessous et s'il/elle connait aussi le "prompt", c'est encore mieux pour comprendre le fonctionnement.

Donc, commence avec un recherche sur la disque dur et dans un directory qui contient des espaces

Le code de BrunoM45 de hier matin ne donne que 1 résultat qui peut etre un match moins perfect (a cause du "sFic = Dir(sPathIni & "*" & sCrit & "*")"

Sub Ledoc()

     '*************************************************************************************************
     'le but de ce macro, c'est simuler le DOS-prompt avec le commande "DIR" et les 3 éléments path, prefix et extension
     'le seul problème est les éspaces, il faut aujouter un " en face et derrier !!!!
     'Pour ces 3 éléments, on utilise les 3 cellules dans la colonne B, sauf pour les ordinateurs avec username "BSA" la colonne C
     'Donc pour Ledoc, il y a le choix, rien changer oubien effacer tous les ".offset(,b)" dans ces 3 lignes & la ligne "b=-(Application....)"
     '
     'le séparateur normal, c'est le "\", donc d'ou vient ce "/" ? dans "d:photo/" ???  ...  un disque réseau accessible
     'peut-etre on ne peut pas ajouter un "\" entre le path et le prefix à ce point là ????
     '*************************************************************************************************
     Dim MyPath, MyPrefix, MyExtension, sTotal0, sTotal1

     b = -(Application.UserName = "BSA")     'si l'username de l'ordinateur est BSA -> valeur 1, autrement 0
     MyPath = Range("B2").Offset(, b)    'ce dossier + sous-dossiers
     MyPrefix = Range("B3").Offset(, b)   '1er caractères
     MyExtension = Range("B4").Offset(, b)   'extension

     sTotal0 = MyPath & IIf(Right(MyPath, 1) <> "\", "\", "") & MyPrefix & "*" & MyExtension     '--> joindre les 3 éléments
     sTotal1 = Replace(sTotal0, " ", """ """)     '--> PRECAUTION : pour les espaces, ajoute de " " autour !!!!!
     s = "Dir " & sTotal1 & " /b /s"     '---> ligne de commande pour "SHELL"   (n'est que simple DOS commande)
     myfiles = Split(CreateObject("wscript.shell").Exec("cmd /c " & s).StdOut.ReadAll, vbCrLf)      'array avec tous les files

     With Range("E1")
          .EntireColumn.ClearContents     'vider toute la colonne
          If UBound(myfiles) = -1 Then     'rien trouvé
               MsgBox "Désolé  !!!", vbCritical, s
          Else
               MsgBox Join(myfiles, vbLf), vbInformation, s     'messagebox avec tous les fichiers
               .Resize(UBound(myfiles) + 1).Value = Application.Transpose(myfiles)     'ecrire ces fichiers dans la colonne E
               .EntireColumn.AutoFit     'ajuster le largeur de la colonne
               For i = 0 To UBound(myfiles)     'boucle des fichiers
                    If Len(myfiles(i)) > 0 Then     'au moins 1 charactère
                         MsgBox "file numéro : " & i + 1 & "    " & myfiles(i)     'messagebox avec ce fichier
                         ShellExecute 0, vbNullString, myfiles(i), vbNullString, vbNullString, 0     ''ouvre avec la visionneuse photo de Windows
     'Application.Wait Now + TimeSerial(0, 0, 3)     'ajouter un petit delai pour l'action précedente
                         DoEvents
                    End If
               Next
          End If
     End With

End Sub

bonjour .

je suis en train de tester le code de bruno .

a mon boulot sous office13pro j'obtiens une erreur

j'ai aussi testé chez moi sous office21 et ça fonctionne.

j'ai donc testé avec plusieurs fichiers portant le même nom que la cellule d11 avec des noms identiques ou des noms plus long.

1fichier jpg,1fichier tif et1fichier txt.

Si je mets les 2 fichiers jpg et tif c'a m'ouvre le fichier jpg.

Si je mets le fichier tif seul ca me l'ouvre bien.

Si je mets que le txt ça ne me l'ouvre pas.

Ca ne gere pas les sous dossier.

pour ce qui est de everything,je ne peut pas installer de logiciel au boulot.

pour le/ c'est une erreur de ma part dsl.

Bonjour ledoc,

Petit rappel de la demande initiale

je souhaiterais créé une macro xl pour rechercher des fichiers sur le disque dur dont le nom incomplet serai inscrit dans une cellule.

Je voudrais aussi qu'une fois trouver, le fichier s'ouvre avec l'application par défaut de windows.

Et si aucun fichier trouvé , un msgbox s'affiche pour nous le dire .

Donc si 1 seul fichier s'ouvre, c'est normal puisque demandé ainsi

Que ça ne gère pas les sous-dossier, normal également puisque non explicitement indiqué

Voici le nouveau code

Sub Test()
  Dim sPath As String, sCrit As String
  ' Initialiser les variables
  sPath = Range("B1").Value
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
  sCrit = Range("B2").Value
  ' Appeler la procédure
  Call OuvrirTousLesFichiers(sPath, sCrit)
End Sub

' Nécessite d'activer la référence "Microsoft Scripting RunTime"
Sub OuvrirTousLesFichiers(sPath As String, sCrit 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
    ' On met en majuscule pour éviter problème de casse
    If UCase(FileItem.Name) Like "*" & UCase(sCrit) & "*" Then
      ShellApp.Open (FileItem.ParentFolder & "\" & FileItem.Name)
    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
  Next SubFolder
End Sub

Et le fichier

A+

@BrunoM45, il y a 8 jours que j'ai posté un code parreil, mais il était trop tordu pour un débutant ... .

Cela ne fonctionnait pas à ce moment, je crains, pas sur, car il y a des espaces dans le subdirectory ou dans le nom. Bonne chance.

Bonjour Bruno

ton nouveau code fonctionne bien.

Je l'ai modifié un peut pour rajouter le critère extension , çà fonctionne aussi.

Par contre je n'arrive pas à faire le code pour afficher une msgbox en cas de fichier non trouvé.

Bonsoir

@Ledoc il va falloir apprendre un peu le VBA et les conditions If... Then... Else... Endif

Je vous ai donné la piste, à vous d'en déduire la solution qui n'est pas difficile à trouver

@BsAlv absolument pas le même le votre avec "dictionnary" et autres fioritures dont on n'a absolument pas besoin

A+

@Bruno, il faut comparaitre ma reponse du 17/5 à 20:41 avec celui de hier 12:52. Il n'avait rien de dictionary ou fioritures la dedans. C"était un code que j'avais copier et adapter directement de l'internet. Le "vrai" problème ici, c'étaient les espaces dans les subdirectories, si non, ma première response était directement aprouvée. Ma response de dimanche 7:05 etait une versions 2.0 de cette reaction, qui, à mon avis, avait résolu le problemes des espaces.

Bon, je ne discute plus la dessus ! Bonne nuit.

Bonjour BsAlv

Je suppose que vous voulez rire (moi pas )
Dans ce post justement https://forum.excel-pratique.com/s/goto/1066663

Ce que j'appelle "fioritures" ce sont

colFolders As New Collection

Set dict = CreateObject("scripting.dictionary")

DoEvents
sp = Split(oFile, "\")
sfilename = sp(UBound(sp))

colFolders.Add sf 'add to collection for processing

Etc...

Alors, je me répète même si cela vous déplait... arrêter de sortir votre science qui ne sert à rien dans le cas présent
et mettez-vous au niveau des demandeurs

Mon code est basique et compréhensible, je pense, par le commun des mortels

lu

Oui Bruno

J'avais bien compris qu'il fallait que j'utilise if then else endif.

Mais je ne vois pas qu'elle variable je peut utiliser pour if et else

If variable ="" then

Msgbox "Pas de fichier trouvé",vbcritical, "oups..."

Else

bon finalement j'ai trouvé.

Par contre ca m'ouvre la msgbox 5fois

bonjour Bruno.

je ne sais pas comment utiliser le msgbox pour ce code.

Il faudrait que je l'utilise en dehors des boucles for each, mais je ne vois pas là .

aurait tu une idée s'il te plaît?

Bonsoir Ledoc,

On peut faire comme ceci

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

Sub Test()
  Dim sPath As String, sCrit As String
  ' Initialiser les variables
  sPath = Range("B1").Value
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
  sCrit = Range("B2").Value
  ' Mettre le flag à FAUX
  FlgOk = False
  ' Appeler la procédure
  Call OuvrirTousLesFichiers(sPath, sCrit)
  ' 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)
  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
    ' On met en majuscule pour éviter problème de casse
    If UCase(FileItem.Name) Like "*" & UCase(sCrit) & "*" 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
  Next SubFolder
End Sub

Sinon à quel moment voulez-vous le message sinon

A+

Edit modo

Bonjour Bruno

Désolé pour le délai

J'ai testé ton code chez moi sur mon fichier de test sous xl2021 et il fonctionne bien

Testé aussi au boulot sur un fichier de test sous xl2013 et çà fonctionne bien

J'ai donc recopié la macro sur mon fichier de travail et je l'ai associé a un bouton de contrôle de formulaire

çà fonctionne aussi mais par contre çà met du temps , je m'explique :

Une fois cliqué sur le bouton çà m'ouvre casi instantanément en 1er la visionneuse photo puis un peut après la photo en question

Jusque là c'est bon , par contre une fois que je referme la photo je m'aperçois que la recherche semble continuée ,

Le bouton est toujours enfoncé et le curseur de sourie et en mode "moulinage" , ce pendant environ 50secondes

je ne sais pas si çà viens du code ou bien du pc qui est lent ou du faite qu'il y a beaucoup de sous répertoires et de fichiers

Ou bien on dirai que le code , même si il a trouvé un fichier , continu de chercher pour voir si 'il y en a pas d'autre

Je précise , que j'ai rajouter dans ton code le critère sExt pur l'extension du fichier à rechercher

Bonjour Ledoc,

Je pense qu'il va falloir remettre vos idées ne place

Je fais un code pour que le 1er fichier trouvé s'ouvre, vous me dite la dessus que le code n'ouvre pas les autres (ce que j'ai compris)
https://forum.excel-pratique.com/s/goto/1068513

Je fais un autre code pour que cela les ouvre tous et maintenant
"Ou bien on dirai que le code , même si il a trouvé un fichier , continu de chercher pour voir si 'il y en a pas d'autre"

Vous êtes sérieux ?

Bon moi je laisse tomber, je vous laisse aux mains de BsAlv qui va juste vous farcir le crâne, mais avec du code bien plus rapide

Tchao

Dsl Bruno si je n'ai pas était clair dès le début, je vais refaire ma demande plus clairement

Ce que je souhaite c'est : pour rechercher un fichier via son nom incomplet écrit dans une cellule , une fois trouvé çà l'ouvre directement avec le logiciel par défaut de windows . Si pas de fichier trouvé un msgbox nous le dira . la recherche doit se faire dans un dossier ainsi que dans tous les sous dossiers

En plus clair : recherche la photo via son nom incomplet noté dans la cellule B2(sCrit) dans le répertoire(sRep) et avec l'extension de fichier(sExt)

Une fois trouvé on stoppe la recherche et on ouvre la photo dans la visionneuse.

Si pas de fichier trouvé , on affiche un msgbox

En tous cas merci à toi d'avoir passer du temps et de mettre en commentaire ton code ;)

Re,

Il suffit donc de modifier cette partie du code... j'espère

    If UCase(FileItem.Name) Like "*" & UCase(sCrit) & "*" Then
      ShellApp.Open (FileItem.ParentFolder & "\" & FileItem.Name)
      ' Au moins 1 fichier trouvé, on met le flag à VRAI
      FlgOk = True
     ' On sort de la boucle "infernale" ICI
     Exit sub
    End If

Merci bien

Je testerai çà mardi au boulot ;)

Bonjour Bruno.

J'ai testé le exit sub mais ça n'a aucun effet sur le "moulinage" d'excel.