Petite macro permettant de choisir un dossier puis de parcourir le dossiers et ses sous-dossiers afin d'ouvrir uniquement les fichiers Excel en vu de les traiter à l'aide de votre propre macro. Pratique pour des mises à jour en masse sur des séries de classeurs contenu dans des arborescences complexes :
Client A
--> Année xx
-----> Gamme A
--------> Produit A.xls
--------> Produit B.xls
-----> Gamme B
--------> Produit C.xls
Source / Exemple :
Sub Choisir_fichiers()
' Macro à appeler dans votre classeur de macros
' Ouvre les fichiers Excel contenu dans un dossier et ses sous-dossiers
'
Dim Fso As Scripting.FileSystemObject ' Gestionnaire de fichiers Windows
Dim Nomdossiers As Scripting.Folders ' Collection des dossiers
Dim Nomfichiers As Scripting.Files ' Collection des fichiers
Dim ApplSelectionDossier As FileDialog ' Boite de dialogue d'ouverture de fichiers/dossiers
'Création de la boîte de dialogue de choix du dossier
Set ApplSelectionDossier = Application.FileDialog(msoFileDialogFolderPicker)
'Choix du dosiier
With ApplSelectionDossier
' Titre de la boite de dialogue
.Title = "Sélectionnez un dossier"
'L'utilisateur a cliqué sur le bouton OK de la boite de dialogue
If .Show = -1 Then
' Créer un objet de gestion des fichiers
Set Fso = CreateObject("Scripting.FileSystemObject")
' Affecte la liste des sous-dossiers du dossier sélectionné
Set Nomdossiers = Fso.GetFolder(.SelectedItems(1)).SubFolders
' Affecte la liste des fichiers du dossier en-cours
Set Nomfichiers = Fso.GetFolder(.SelectedItems(1)).Files
' Appel de la procédure d'ouverture des fichiers
Call Ouvrir_fichier(Nomdossiers, Nomfichiers)
'L'utilisateur a cliqué sur le bouton Annuler
Else
' Rien
' Fin si
End If
End With
End Sub
' Procédure de parcours de dossiers en mode récursif
Sub Ouvrir_fichier(Nomdossiers As Scripting.Folders, Nomfichiers As Scripting.Files)
Dim Nomdossier As Scripting.Folder ' Propriétés Dossier
Dim Nomfichier As Scripting.File ' Propriétés Fichier
Dim Fso As Scripting.FileSystemObject ' Gestionnaire de fichiers Windows
' S'il n'y a aps de fichiers dans le répertoire en cours
If Nomfichiers Is Nothing Then
' Rien
Else
' Pour chaque fichier de la liste de fichiers
For Each Nomfichier In Nomfichiers
' Si L'extension du fichier est .xls ou .xlsx (Excel)
If Right(Nomfichier, 4) = ".xls" Or Right(Nomfichier, 5) = ".xlsx" Then
' Ouvrir le fichier
Workbooks.Open Filename:=Nomfichier
' ****************** Appeler la macro ici ***********************************
' ****************** Fin appel de la macro **********************************
'Enregistre avant de fermer
ActiveWorkbook.Save
'Ferme le fichier
ActiveWorkbook.Close
' Fin si
End If
' fichier suivant
Next
' Fin si
End If
' S'il n'y a pas de sous-dossiers dans Nomdossier
If Nomdossiers Is Nothing Then
' Rien
Else
' Pour chaque dossier de la liste de dossiers
For Each Nomdossier In Nomdossiers
' Créer un objet de gestion des fichiers
Set Fso = CreateObject("Scripting.FileSystemObject")
' Affecte la liste des fichiers du dossier en cours
Set Nomfichiers = Fso.GetFolder(Nomdossier.Path).Files
' Appel la procédure d'ouverture des fichiers (récursif)
Call Ouvrir_fichier(Nomdossier.SubFolders, Nomfichiers)
' Dossier suivant
Next Nomdossier
' Fin si
End If
End Sub
Conclusion :
Il s'agit d'un code sans prétention mais qui peut rendre de grands services à des bureau d'études ou services commerciaux. Il suffit d'insérer l'appel de votre propre macro pour automatiser le traitement de tous vos fichiers ayant une structure identique.
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.