Rechercher et ouverture fichier dans sous-répertoire [Résolu]

titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention - 22 août 2014 à 09:11 - Dernière réponse : titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention
- 25 août 2014 à 09:54
Bonjour,

Je travaille sous Excel 2007.

Voici mon problème :
Je cherche à ouvrir un fichier dans des sous-répertoires sans savoir dans quel sous-répertoire le fichier se trouve.
La sélection de ce fichier est faite par l'utilisateur dans une feuille excel par rapport à une partie du nom de fichier (variable Numcapa).

J'ai créer le code suivant (une partie a été copié d'un site internet mais je ne sais plus lequel) :

Sub FichierAOuvrir(ByVal Repertoire As String, ByVal Numcapa As String)

    Dim fso As Object
    Dim Dossier As Object
    Dim SousDossier As Object
    Dim d As Object
    Dim Fichier As Object
    Dim NomFichier As String
    Dim EstTrouve as Boolean
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(Repertoire)
    
    EstTrouve = False
    
    'examen du dossier courant
    For Each d In Dossier.SubFolders
        For Each Fichier In d.Files
            If Fichier.Name Like Numcapa & "*.xls" Then
                If Not Fichier.Name Like "*notice*" Then
                    NomFichier = d & "" & Fichier.Name
                    ' si le fichier a été trouvé, on l'ouvre et on sort de la boucle
                    EstTrouve = True
                    Workbooks.Open NomFichier
                    Exit Sub
                End If
            End If
        Next Fichier
        ' afin d'éviter de rechercher dans les autres fichiers du même sous dossier, on sort de la boucle

    Next d
 
    'traitement récursif des sous dossiers
    For Each SousDossier In Dossier.SubFolders
        FichierAOuvrir SousDossier.Path, Numcapa
    Next SousDossier
    
    Set fso = Nothing
    
End Sub

Quand le fichier existe, il s'ouvre (donc tout va bien) mais le programme continue malgré le "exit sub" du 1er "For Each Fichier.....". Il continue sur le 2ème "For Each Sousdossier....."

Le programme sort de la procédure quand il a fini de chercher dans tous les sous-dossier (2ème for Each) et donc ne tient pas compte de la commande "Exit Sub" même si le fichier à été trouvé
J'aimerai affiché un message d'avertissement à l'utilisateur quand le fichier n'est pas trouvé mais impossible de savoir où positionner ce msgbox car la variable "EstTrouve" ne garde pas sa valeur "True". Il m'est donc impossible de tester cette variable.

J'espère avoir été claire et concise.

Titigunners
Afficher la suite 

Votre réponse

15 réponses

Whismeril 11797 Messages postés mardi 11 mars 2003Date d'inscriptionContributeurStatut 18 juillet 2018 Dernière intervention - 22 août 2014 à 09:18
0
Merci
Message modifié pour ajouter les balises de code.
Voir ici comment utiliser la coloration syntaxique.
Commenter la réponse de Whismeril
jordane45 21674 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 juillet 2018 Dernière intervention - Modifié par jordane45 le 22/08/2014 à 12:04
0
Merci
Bonjour,

Pour une recherche de fichier via VBA (Excel) je t'invite plutot à utiliser la class : FileSearch

http://jr.loucan.fr/e107_plugins/forum/forum_viewtopic.php?9

=> La class est disponible sur le site : http://silkyroad.developpez.com/vba/classefilesearch/ ainsi que dans mon lien précédent...



Maintenant... si tu veux conserver le CODE que tu utilises actuellement...
je pense que tu as oublié un SLASH...
à la ligne :
   NomFichier = d & "" & Fichier.Name

Et là...ton exit Sub marche...

Pour ce qui est de mettre un message d'erreur.... il te suffit de rajouter un IF.
    If EstTrouve = False Then
        MsgBox ("Le fichier : " & Numcapa & ".xls n'existe pas")
    End If


Ce qui donne :

Sub FichierAOuvrir()
    Dim Repertoire As String
    Dim Numcapa As String
    Dim fso As Object
    Dim Dossier As Object
    Dim SousDossier As Object
    Dim d As Object
    Dim Fichier As Object
    Dim NomFichier As String
    Dim EstTrouve As Boolean
    
    Repertoire = "C:\TEMP"
    Numcapa = "Export_HNO_11Mar2014-28"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(Repertoire)
    
    EstTrouve = False
    
    'examen du dossier courant
    For Each d In Dossier.SubFolders
        For Each Fichier In d.Files
            If Fichier.Name Like Numcapa & "*.xls" Then
                If Not Fichier.Name Like "*notice*" Then
                    NomFichier = d & "" & Fichier.Name
                    ' si le fichier a été trouvé, on l'ouvre et on sort de la boucle
                    EstTrouve = True
                    Workbooks.Open NomFichier

                    'Exit Sub
                    'Si tu veux ensuite les ouvrir... pourquoi ne pas le faire directement ICI...
                    FichierAOuvrir SousDossier.Path, Numcapa
                End If
            End If
        Next Fichier
        ' afin d'éviter de rechercher dans les autres fichiers du même sous dossier, on sort de la boucle

    Next d
 
    If EstTrouve = False Then
        MsgBox ("Le fichier : " & Numcapa & ".xls n'existe pas")
    End If

    
    Set fso = Nothing
    
End Sub






Avant de poser une question, merci de lire la charte du site.
Cordialement, Jordane
Commenter la réponse de jordane45
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 22 août 2014 à 11:57
0
Merci
Bonjour,
Ce que je ne cerne personnellement pas est ceci :
1) "La sélection de ce fichier est faite par l'utilisateur dans une feuille excel par rapport à une partie du nom de fichier (variable Numcapa). "
2) corroboré par cela :
"If Fichier.Name Like Numcapa & "*.xls" Then"
Qui donne à supposer que plusieurs fichiers ainsi "nommés partiellement" pourraient éventuellement exister. Et dans un tel cas : lequel d'entre eux ouvrir ???? (puisque tu quittes après en avoir trouvé UN) !
Parle-nous plus complètement des raisons de cet aspect, qui m'intriguent
Commenter la réponse de ucfoutu
titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention - Modifié par titigunners le 22/08/2014 à 14:43
0
Merci
Bonjour,

J'ai testé le code de Jordan. Celui-ci fonctionne mais seulement pour les fichiers du sous-répertoire.
La recherche ne va pas dans les sous-répertoire des sous-répertoire
En fait le programme ne passe pas sur la ligne :
                    'Si tu veux ensuite les ouvrir... pourquoi ne pas le faire directement ICI...
FichierAOuvrir SousDossier.Path, Numcapa

Je pense qu'il me manque une recherche sur les sous-répertoire avant la ligne :

For Each Fichier In d.Files
mais je ne sais pas comment la mettre

Je n'ai pas testé la fonction FileSearch (pas encore eu le temps)

Pour répondre à ucfoutou :
Effectivement plusieurs fichiers peuvent être nommés partiellement Numcapa & "*.xls" d'où le test à la ligne 24 :

If Not Fichier.Name Like "*notice*" Then

Mon problème se situe que le programme ne quitte pas après avoir trouvé le fichier :

If Not Fichier.Name Like "*notice*" Then
NomFichier = d & "" & Fichier.Name
' si le fichier a été trouvé, on l'ouvre et on sort de la boucle
EstTrouve = True
Workbooks.Open NomFichier
Exit Sub
End If

Il continue la recherche dans tous les sous-dossiers : qu'il trouve ou pas le fichier, la variable EstTrouve est toujours false


Merci
jordane45 21674 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 juillet 2018 Dernière intervention - 22 août 2014 à 14:53
Mon problème se situe que le programme ne quitte pas après avoir trouvé le fichier
Si... mais à condition qu'il trouve le fichier !
Comme tu le dis toi même :
il me manque une recherche sur les sous-répertoire
Oui... c'est pour ça qu'il faut utiliser du récursif...

Mais bon... si tu quittes après avoir trouvé UN FICHIER ... il n'ira pas chercher les autres... et n'ira pas jusqu'à ton code d'ouverture ( si on reprend TON code tel qu'il est....)...

Donc....
Comme te le demande Ucfoutu... commence par nous REFORMULER exactement, en détail et le plus clairement possible, ce que tu souhaites faire.....
Par exemple :
" Je veux ouvrir TOUS les fichiers qui commencent par ...... .xls ....."
Commenter la réponse de titigunners
cs_MPi 3872 Messages postés mardi 19 mars 2002Date d'inscription 13 juillet 2018 Dernière intervention - 22 août 2014 à 14:56
0
Merci
Comme tu crées une fonction récursive, ta variable EstTrouve redevient False lorsqu'elle est rappelée dans la dernière partie.

Essaie en mettant ta variable en début de module
Commenter la réponse de cs_MPi
titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention - Modifié par titigunners le 22/08/2014 à 15:41
0
Merci
Merci de me répondre rapidement.

Je vais essayer d'être claire (je me doutais bien que ce n'était pas très compréhensive même si c'est très claire dans ma tête).

Voici l'arborescence de mes répertoires :

Le répertoire générale est : W:\Quality\Corrective & preventive Action Request
avec un sous répertoire par année donc pour 2014, il y a un dossier 2014 avec des sous-dossier :
2014_opened
2014_closed

Et avec des sous-dossier portant un nom commençant par la variable "NumCapa".

Ce qui donne au final 3 chemins possibles pour trouver le fichier :

1 - W:\Quality\Corrective & preventive Action Request\2014\NumCapa....\NumCapa...xls
2 - W:\Quality\Corrective & preventive Action Request\2014\2014_opened\NumCapa....\NumCapa...xls
3 - W:\Quality\Corrective & preventive Action Request\2014\2014_closed\NumCapa....\Numcapa...xls

Le fichier que l'utilisateur choisit d'ouvrir ne peut se trouver qu'à un seul endroit parmi ces 3 chemins (sans savoir lequel)

J'aimerai que lorsque
- le fichier NumCapa...xls est trouvé, il s'ouvre : OK
- le fichier NumCapa...xls n'est pas trouvé, un message s'affiche du style
MsgBox ("Le fichier : " & Numcapa & ".xls n'existe pas")

Si le code doit être changé, je n'ai aucun souci avec cela

J'espère avoir été plus claire

Merci
jordane45 21674 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 juillet 2018 Dernière intervention - 22 août 2014 à 15:29
DOnc..le mieux... c'est d'utiliser le classFileSearch.
Commenter la réponse de titigunners
titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention - 22 août 2014 à 15:45
0
Merci
Encore une fois merci de répondre rapidement.

Je ne connais pas cette classe
C'est la première fois que je développe une macro qui doit ouvrir un fichier.
Je regarde cela dès lundi.
Ma mission se termine le vendredi 29/08, j'espère avoir le temps d'ici de terminer ce projet.

Merci
Commenter la réponse de titigunners
jordane45 21674 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 juillet 2018 Dernière intervention - 22 août 2014 à 17:08
0
Merci
Pour utiliser ClasseFileSearch :

Dans un module de classe nommé : ClasseFileSearch
Option Compare Text
Option Base 1
'-------------------------------------------------
'Module de classe ClasseFileSearch pour Excel 2007
'SilkyRoad
'http://silkyroad.developpez.com/
'Mise à jour le 01.07.2007
'-------------------------------------------------

'La procédure recherche des fichiers en fonction des critères
'spécifiés et renvoie dans un tableau :
    
    'Le nom des fichiers
    'Le chemin
    'La taille des fichers (en octets)
    'La date de création
    'La date de dernière modification
    'Le type de fichier)

'-------------------------------------------------

'Enumération pour les options de tri
Public Enum Sort_By
    Sort_None
    sort_Name
    sort_Path
    sort_Size
    sort_DateCreated
    sort_LastModified
    sort_Type
End Enum


Dim TabFiles() As InfosResultFichiers
Dim DirectoryPath As String
Dim lngFoundFilesCount As Long
Dim boolSousRep As Boolean
Dim strExtens As String
Dim optionSortBy As Long



'Propriété pour le répertoire de recherche
Public Property Let FolderPath(strFolderPath As String)
    DirectoryPath = strFolderPath
End Property


'Propriété pour rechercher dans les sous dossiers
Public Property Let SubFolders(boolSubFolders As Boolean)
    boolSousRep = boolSubFolders
End Property


'Propriété pour lister les fichiers correspondants à la requête
Public Property Get Files(Idx As Long) As InfosResultFichiers
    Files = TabFiles(Idx)
End Property


'Propriété pour l'extension des fichiers à rechercher
Public Property Let Extension(strExtension As String)
    strExtens = strExtension
End Property


'Propriété pour compte le nombre de fichiers
Public Property Get FoundFilesCount() As Long
    FoundFilesCount = lngFoundFilesCount
End Property


'Propriété pour l'option de tri
Public Property Let SortBy(lngSortBy As Sort_By)
    optionSortBy = lngSortBy
End Property


'Fonction d'exécution
Public Function Execute() As Long
    'Lance la recherche
    ListeFichiers DirectoryPath
    
    'Vérifie que des fichiers ont été trouvés et qu'une option de tri a
    'été spécifié avant de lancer la procédure de tri.
    If lngFoundFilesCount > 1 And optionSortBy <> Sort_By.Sort_None Then _
        FonctionTri optionSortBy
        
    Execute = lngFoundFilesCount
End Function



'Procédure pour lister les fichiers
Private Sub ListeFichiers(strFolderName As String)
    Dim Fso As Object
    Dim NomDossier As Object, SousDossier As Object
    Dim objFichier As Object
    
    On Error GoTo Fin
    
    
    'Vérifie si le dossier spécifié existe
    If Dir(strFolderName, vbDirectory Or vbHidden Or vbSystem) = "" Then Exit Sub
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set NomDossier = Fso.GetFolder(strFolderName)
    
    
    'Boucle sur les fichiers du répertoire
    For Each objFichier In NomDossier.Files
        
        'Vérifie l'extension du fichier
        If objFichier.Name Like strExtens Or strExtens = "" Then
            
            'Redimensionne le tableau pour ajouter un nouvel élément
            lngFoundFilesCount = lngFoundFilesCount + 1
            ReDim Preserve TabFiles(lngFoundFilesCount)
            
            'Nom fichier
            TabFiles(lngFoundFilesCount).strFileName = objFichier.Name
            'Répertoire
            TabFiles(lngFoundFilesCount).strPathName = objFichier.ParentFolder
            'Taille du fichier (en octets)
            TabFiles(lngFoundFilesCount).lngSize = objFichier.Size
            'Date de création
            TabFiles(lngFoundFilesCount).DateCreated = objFichier.DateCreated
            'Date de création ou dernière modification
            TabFiles(lngFoundFilesCount).DateLastModified = objFichier.DateLastModified
            'Type de fichier
            TabFiles(lngFoundFilesCount).strFileType = objFichier.Type
        End If
    Next objFichier
    
    
    'Boucle récursive:
    '(Si l'option de recherche dans les sous répertoires a été spécifiée)
    If boolSousRep Then
        For Each SousDossier In NomDossier.SubFolders
            ListeFichiers SousDossier.Path
        Next SousDossier
    End If
    
    
Exit Sub:

Fin:
MsgBox "Erreur '" & Err.Number & "'" & vbCrLf & vbCrLf & _
    Err.Description, vbInformation
End Sub



'Procédure de tri (reste à améliorer).
Private Sub FonctionTri(optionSortBy As Sort_By)
    Dim i As Long, j As Long, k As Long
    Dim ValTemp As Variant
    
    'Vérifie quel champ du tableau doit être trié
    Select Case optionSortBy
                  
        Case Sort_By.sort_Name
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).strFileName <= TabFiles(j).strFileName Then j = k
                    If TabFiles(k).strFileName <= TabFiles(j).strFileName Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                    ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
    
    
         Case Sort_By.sort_Path
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).strPathName <= TabFiles(j).strPathName Then j = k
                    If TabFiles(k).strPathName <= TabFiles(j).strPathName Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                    ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
   
   
          Case Sort_By.sort_Size
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).lngSize <= TabFiles(j).lngSize Then j = k
                    If TabFiles(k).lngSize <= TabFiles(j).lngSize Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                     ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
  
  
        Case Sort_By.sort_DateCreated
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).DateCreated <= TabFiles(j).DateCreated Then j = k
                    If TabFiles(k).DateCreated <= TabFiles(j).DateCreated Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                     
                     ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
            
  
        Case Sort_By.sort_LastModified
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).DateLastModified <= TabFiles(j).DateLastModified Then j = k
                    If TabFiles(k).DateLastModified <= TabFiles(j).DateLastModified Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                     ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                   
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
  
         Case Sort_By.sort_Type
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).strFileType <= TabFiles(j).strFileType Then j = k
                    If TabFiles(k).strFileType <= TabFiles(j).strFileType Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                      ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                  
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
    
    End Select
End Sub





Dans un MODULE "standard" :

Option Explicit

Public Type InfosResultFichiers
    strFileName As String
    strPathName As String
    lngSize As Long
    DateCreated As Date
    DateLastModified As Date
    strFileType As String
End Type


Public Function Nouvelle_Recherche() As ClasseFileSearch
    Set Nouvelle_Recherche = New ClasseFileSearch
End Function


Function ListeFichiers(NomF As String, chemin As String, Recursif As Boolean, ParamArray Exclu())
'-------------------------------------------------------------------
'Fonction permettant de lister les fichiers d'un répèertoire donnée
' NomF => Nom de la feuille ou copier les données
' Chemin => Répèertoire à scanner
' Recursif => Mode récursif ou non (recherche dans les sous dossiers)
' Exclu => liste du/des Fichier(s) à Exclure de la liste
'-------------------------------------------------------------------
'******************************************************************
Dim arrFile As Variant ' tableau contenant la liste des fichiers trouvés
    arrFile = Array(1)
Dim NbFichiers As Integer ' Nb de fichiers dans le répertoire
Dim NomFichier As String ' Nom du fichier
Dim XCLU As Boolean ' test si trouve des fichiers a exlure
XCLU = False 'valeur par défaut
Dim Recherche As New ClasseFileSearch
Set Recherche = Nouvelle_Recherche
Dim i As Long
Dim j As Long
Dim x As Long

With Recherche
    .FolderPath = chemin
    .SubFolders = Recursif
    If .Execute > 0 Then

        NbFichiers = .FoundFilesCount
        '----------------------------------------------------
        '------ parcoure le répèrtoire
        '----------------------------------------------------
        For i = 1 To NbFichiers
            NomFichier = .Files(i).strFileName
            chemin = .Files(i).strPathName
            '----------------------------------------------------
            '------ Test si fait parti des exclusions
            '----------------------------------------------------
            For j = 0 To UBound(Exclu)
                If NomFichier Like Exclu(j) Then
                    XCLU = True
                End If
            Next j
            
            '----------------------------------------------------
            ' ------ Traitement si le fichier correspond à la recherche
            '----------------------------------------------------
            If XCLU <> True Then
                If NomFichier Like NomF Then
                    'Ajout du fichier dans la variable tableau
                    x = UBound(arrFile)
                    ReDim Preserve arrFile(x + 1)
                    arrFile(x) = chemin & "" & NomFichier
                End If
            End If
        Next i
     End If
End With
ListeFichiers = arrFile
End Function





Et enfin...
Pour l'utiliser il te suffit ensuite de mettre (par exemple) :

Sub test()
Dim mesFichiers As Variant
Dim f As Long
Dim Numcapa As String
    Numcapa = "Export*"
mesFichiers = ListeFichiers(Numcapa & "*.xls", "C:\TEMP", True, False)

For f = 1 To UBound(mesFichiers) - 1
    Debug.Print mesFichiers(f)
Next


End Sub


Commenter la réponse de jordane45
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 22 août 2014 à 19:28
0
Merci
Excusez-moi, mais la problématique reste pour moi entière.
Je cite :
Effectivement plusieurs fichiers peuvent être nommés partiellement Numcapa & "*.xls" d'où le test à la ligne 24 :

If Not Fichier.Name Like "*notice*" Then
Laisse entendre que tu ne veux pas ouvrir les fichiers contenant la chaîne "notice", y compris si elle contien Numcapa et ".xls", mais n'établit pas clairement l'existence d'un UNIQUE fichier contenant Numcapa et ".xls" mais ne contenant pas "notice" !
Alors :
1) Soit il n'y en a qu'un seul et dans ce cas :
- je ne vois pas pourquoi tu n'en connais pas le nom (d'où vient-il ?)
- je ne vois pas non plus pourquoi tu le recherches dans toute une arborescence de répertoire (tu ne sais pas où tu l'as placé ?). Et même dans un tel cas (nom du fichier connu mais sous-dossier ignoré) : quelques lignes de code (que je t'écrirais alors) suffiraient pour le trouver, ce fichier, très rapidement.
2) Soit il y en a plusieurs répondant à tes critères (dans un seul ou plusieurs sous-dossiers) du répertoire "fouillé" et je ne vois alors pas comment tu choisis le bon (celui à ouvrir)

Tout cela me donne à penser que le problème de base est avant tout un problème de conception (nommage des fichiers), qu'il conviendrait de revoir.
Commenter la réponse de ucfoutu
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 23 août 2014 à 18:07
0
Merci
Re bonjour,
je viens d'ailleurs de lire ce que tu as écrit ici :
- le fichier NumCapa...xls n'est pas trouvé, un message s'affiche du style

MsgBox ("Le fichier : " & Numcapa & ".xls n'existe pas")
qui n'a de sens (ton msgbox) que ni numcapa est en effet le nom exact du fichier

Ne reste alors que le problème du sous-dossier à déterminer ... et c'est alors tout bête ===>>

Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long

Private Sub Command1_Click()
Dim repertoire As String, numcapa As String
repertoire = "W:\Quality\Corrective & preventive Action Request\2014"
numcapa = "NumCapa...xls" '===>> ici le nom exact (avec son extension .xls)
MsgBox trouve(repertoire, numcapa)
End Sub

Private Function trouve(R As String, F As String) As String
Dim T As String, resu As Long
T = String(260, 0)
trouve = "le fichier " & F & " n'existe pas"
resu = SearchTreeForFile(R, F, T)
If resu <> 0 Then
trouve = Left$(T, InStr(1, T, Chr$(0)) - 1): Exit Function
End If
End Function

ATTENTION : un bug des balises code fait qu'est ignoré le slash \ suivi de guillemets !
Je corrige donc hors balises code :
la ligne disant :
repertoire = "W:\Quality\Corrective & preventive Action Request\2014"
doit s'écrire :
repertoire = "W:\Quality\Corrective & preventive Action Request\2014\"

Commenter la réponse de ucfoutu
titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention - Modifié par titigunners le 25/08/2014 à 09:12
0
Merci
Bonjour,

Ucfoutou, mon problème est le suivant :
1 - je ne connais pas le nom exact du fichier mais seulement une partie (NumCapa). NumCapa est une valeur dans une cellule d'une feuille excel.
Lorsque l'utilisateur (pas moi) se positionne sur cette cellule, il peut cliquer sur un bouton (OPEN) dans la feuille pour ouvrir ce fichier afin de le consulter, le modifier...
Or dans la feuille excel où se trouve la variable NumCapa, je n'ai pas la totalité du nom du fichier seulement le NumCapa d'où mon problème
2 - Seulement 2 fichiers xls ont la variable NumCapa dans le nom : le NumCapa à ouvrir et le NumCapa...notice.

Jordane,
J'ai testé ton code et j'ai une erreur de compilation sur la ligne suivante :

Dim Recherche As New ClasseFileSearch

Le message est le suivant : Utilisation incorrecte du mot clé New.

Je l'ai retiré et après j'ai eu la même erreur sur la ligne :

Set Nouvelle_Recherche = New ClasseFileSearch

J'ai installé la macro complémentaire dans le bon répertoire et cocher l'option CFileSearch dans les références.

Merci
jordane45 21674 Messages postés mercredi 22 octobre 2003Date d'inscriptionModérateurStatut 18 juillet 2018 Dernière intervention - 25 août 2014 à 09:49
Bonjour,
( j'ai codé pour que tu n'ais pas à la mettre ne macro complémentaire)...
Donc..Si tu reprend mon code directement SANS ajouter la class dans les macro complémentaires mais en la mettant directement dans ton classeur...elle doit fonctionner !
Commenter la réponse de titigunners
titigunners 6 Messages postés vendredi 22 août 2014Date d'inscription 25 août 2014 Dernière intervention - 25 août 2014 à 09:54
0
Merci
Re-Bonjour,

Merci Ucfoutu,
Gràce à toi, j'ai trouvé la solution même en ayant un nom de fichier variable.

Je mets donc en résolu

Pour info, voici le code que j'ai modifié :

Sub OuvertureCAPA()

Dim WbFollow As Workbook ' classeur "CAR Follow Up"
Dim WsFollow As Worksheet ' Onglet "CAPA" du classeur "CAR Follow Up"
Dim NumCapa As String ' Récupérer le numéro de CAPA créé
Dim repertoire As String ' répertoire
Dim DateCapa As String ' Année du CAPA

Set WbFollow = ActiveWorkbook
Set WsFollow = WbFollow.Sheets("CAPA")

' Récupération du numéro du CAPA
WsFollow.Activate
NumCapa = ActiveCell.Value & "*.xls"

' Récupération de l'année du CAPA
DateCapa = Mid(NumCapa, 6, 4)

repertoire = "W:\Quality\Corrective & preventive Action Request" & DateCapa & ""

On Error GoTo fin
Workbooks.Open trouve(repertoire, NumCapa)
Exit Sub

fin:
MsgBox trouve(repertoire, NumCapa)
Exit Sub

End Sub
Function trouve(R As String, F As String) As String

Dim T As String, resu As Long

T = String(260, 0)

trouve = "le fichier " & F & " n'existe pas"

If Not NumCapa Like "notice*" Then
resu = SearchTreeForFile(R, F, T)
If resu <> 0 Then
trouve = Left$(T, InStr(1, T, Chr$(0)) - 1)
Exit Function
End If
End If

End Function


Peut-être à une prochaine fois.
Commenter la réponse de titigunners

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.