Chercher un sous-dossier dans un dossier
Bonjour la communauté,
J'ai essayé pas mal de codes sans réellement trouver la solution, ce sont des fonctions qui sont clairement au dessus de mon niveau actuel.
Je cherche à enregistrer un fichier via macro, dans un sous-dossier dont je connais le nom. Ce sous-dossier se trouve aléatoirement dans d'autres sous dossiers. Je ne connais que le nom du dossier général, mais pas les sous-dossiers intermédiaires.
Exemple: C:\Dossier_Général\xxx\xxx \Sous-Dossier -> Le but et d'enregistrer dans Sous-Dossier sans connaitre les noms des deux sous-dossiers en amont.
Je souhaiterai savoir s'il est possible de faire une recherche du sous-dossier depuis le chemin général afin de pouvoir y enregistrer le fichier ?
Merci pour votre aide.
Hello,
Une proposition par PowerQuery. J'ai un peu pompé le code à droite à gauche.
Au global :
- Tu rentres le nom du dossier racine ou dossier général en colonne A ;
- Tu rentres le nom du sous dossier dans lequel tu veux enregistrer ton fichier ;
- Tu clic droit sur le tableau vert et tu fais "Actualiser" ;
Tu peux demander le rafraîchissement de la requête par macro et en fonction du temps d'exécution de la requête tu mets un timer pour dire j'attends x secondes avant de récupérer le contenu de ma cellule E2.
N'hésite pas et à bientôt
@+
Édit: j’ai oublié de mettre le fichier …
Salut Baroute,
Je ne connais pas du tout PowerQuery, je vais donc regarder cela tranquillement demain. et voir comment je peux m'en sortir avec, merci en tout cas ;)
Bonjour,
j'ai dans l'idée que ces sous-dossiers tu les crées par macro.
Si c'est le cas enregistre-les dans une feuille cachée, ça sera beaucoup plus rapide et simple
eric
Salut Eric,
Ils sont créés par Macro mais dans un autre fichier et via des variables donc compliqué de les récupérer.
Re,
Bon au final avec pas mal de bidouille en cherchant sur le net j'ai trouvé une combine. Je cherche un fichier au lieu d'un dossier, récupère son chemin puis supprime le nom du fichier pour obtenir le chemin du dossier. C'est surement pas le plus simple et je ne comprends clairement pas la partie recherche du code, mais ça a la mérite de fonctionner, voici mon code au cas ou cela intéresse quelqu'un :)
Option Explicit
Sub Recherche_Dossier()
'Déclaration des variables
Dim Lien_Fichier As String
Dim Répertoire As String
Dim Fso As Object
Dim Dossier_Départ As Object
'Définition des objects
Set Fso = CreateObject("Scripting.FilesystemObject")
'Choix du répertoire de départ
Répertoire = "Z:\Commercial\2 - Commandes\" & Year(Date) & "\"
'Recherche des fichiers
Set Dossier_Départ = Fso.GetFolder(Répertoire)
Lien_Fichier = Empty
Recherche_Fichier Fso, Dossier_Départ, Nom_Fichier, Lien_Fichier
If Lien_Fichier = Empty Then
MsgBox "Dossier non trouvé."
Else
Annexe.Range("C1") = Left(Lien_Fichier, Len(Lien_Fichier) - 32)
End If
'Réinitialisation des objets
Set Fso = Nothing
End Sub
Sub Recherche_Fichier(Fso As Object, Dossier As Object, Nom1 As String, Nom2 As String)
'Déclaration des variables
Dim Sous_Dossier As Object
Dim Fichier As Object
Dim Nom As String
Dim Extension_Fichier As String
'Recherche fichiers
For Each Fichier In Dossier.Files
Extension_Fichier = Fso.GetExtensionName(Fichier.Path)
If Nom1 = Fichier.Name Then Nom2 = Fichier.Path: Exit For
Nom = Replace(Fichier.Name, "." & Extension_Fichier, "") 'supprime l'extension du nom
If Nom = Nom1 Then Nom2 = Fichier.Path: Exit For
' If MsgBox("Retenez-vous ce nom de fichier avec son extension ? " & Fichier.Name, vbYesNo, "Question") = vbYes Then nom2 = Fichier.Path: Exit For
'End If
Next Fichier
'Recherche sous-dossier
For Each Sous_Dossier In Dossier.SubFolders
If Nom2 <> Empty Then Exit For
If Sous_Dossier.Attributes = vbDirectory + vbSystem + vbHidden Then Exit For
Recherche_Fichier Fso, Sous_Dossier, Nom1, Nom2
Next
End Sub