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

Question

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

Whismeril · Answer

Message modifié pour ajouter les balises de code.
Voir ici comment utiliser la coloration syntaxique.

jordane45 · Answer

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

ucfoutu · Answer

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

titigunners · Answer

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

cs_MPi · Answer

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

titigunners · Answer

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

titigunners · Answer

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

jordane45 · Answer

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

ucfoutu · Answer

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.

ucfoutu · Answer

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 LongPrivate 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 SubPrivate 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 IfEnd 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\"

titigunners · Answer

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

titigunners · Answer

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 SubFunction 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.

Rechercher et ouverture fichier dans sous-répertoire

12 réponses

Votre réponse

Discussions similaires