Bonjour à tous,
J'ai écrit une macro car j'ai besoin de rechercher dans un dossier (et l'ensemble de ses sous dossier) tous les fichiers Excel qu'il contient afin de synthétiser les informations dans un seul fichier (celui contenant la macro).
J'ai trouvé un bout de code sur internet, qui marche à merveille, mais il me liste l'ensemble des fichiers (alors que je veux que les fichiers Excel).
Auriez vous une idée ?
Voici le code :
	
	
	
	
	
		
Merci d'avance !!
	
		
			
		
		
	
				
			J'ai écrit une macro car j'ai besoin de rechercher dans un dossier (et l'ensemble de ses sous dossier) tous les fichiers Excel qu'il contient afin de synthétiser les informations dans un seul fichier (celui contenant la macro).
J'ai trouvé un bout de code sur internet, qui marche à merveille, mais il me liste l'ensemble des fichiers (alors que je veux que les fichiers Excel).
Auriez vous une idée ?
Voici le code :
		Code:
	
	
	Sub MaJ_ListeAPA()
    Der_Lign = Range("E65536").End(xlUp).Row
    Chemin = "Q:\Fiabilisation\AJA - APA\APA"
    ListeFichiers Chemin
End Sub
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
    
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
    
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
    
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
        
        i = i + 1
    Next FileItem
    
    
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub
	Merci d'avance !!
			
				Dernière édition: