Problème Macro - Récupération liste fichiers répertoireRésolu

Question

Bonjour, 

Je suis en train d'adapter une macro de listing des fichiers d'un répertoire mais j'ai un petit souci. 
Le répertoire est composé de dossiers et de nombreux sous-dossiers. 
Voilà le code: 

-------------------------------------------------------------------------------------------------------
Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean)


Dim fso As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oSubFolder As Scripting.Folder
Dim oSub1Folder As Scripting.Folder
Dim oSub2Folder As Scripting.Folder
Dim oSub3Folder As Scripting.Folder
Dim oSub4Folder As Scripting.Folder
Dim oSub5Folder As Scripting.Folder
Dim oSub6Folder As Scripting.Folder
Dim oSub7Folder As Scripting.Folder
Dim oFile As Scripting.File
Dim oSubFile As Scripting.File
Dim oSub1File As Scripting.File
Dim oSub2File As Scripting.File
Dim oSub3File As Scripting.File
Dim oSub4File As Scripting.File
Dim oSub5File As Scripting.File
Dim oSub6File As Scripting.File
Dim wksDest As Worksheet
Dim iRow As Long


'Le listing des fichiers se fera dans la page "Listing des Fichiers" du classeur Excel
Set wksDest = Worksheets("Listing des Fichiers")


wksdest.


Set fso = CreateObject("Scripting.FileSystemObject")


'Formatage de l'entête Listing
With wksDest.Range("A1:H1")
.Font.Bold = True
.Interior.ColorIndex = 42
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With


'Nommage entête Listing
Set oSourceFolder = fso.GetFolder(strFolderName)
wksDest.Cells(1, 1) = "File name"
wksDest.Cells(1, 2) = "Parent folder"
wksDest.Cells(1, 3) = "Size in ko"
wksDest.Cells(1, 4) = "Type"
wksDest.Cells(1, 5) = "Date created"
wksDest.Cells(1, 6) = "Date last modified"
wksDest.Cells(1, 7) = "Date last accessed"
wksDest.Cells(1, 8) = "Full path"


'Début numéro de ligne
iRow = 2


For Each oSubFolder In oSourceFolder.SubFolders
ListFilesInFolder oSubFolder.Path, True


For Each oFile In oSubFolder.Files
wksDest.Cells(iRow, 1) = oFile.Name
wksDest.Cells(iRow, 2) = oFile.ParentFolder.Path
wksDest.Cells(iRow, 3) = oFile.Size / 1000
wksDest.Cells(iRow, 4) = oFile.Type
wksDest.Cells(iRow, 5) = oFile.DateCreated
wksDest.Cells(iRow, 6) = oFile.DateLastModified
wksDest.Cells(iRow, 7) = oFile.DateLastAccessed
wksDest.Cells(iRow, 8) = oFile.Path


iRow = iRow + 1


Next oFile


For Each oSub1Folder In oSubFolder.SubFolders
ListFilesInFolder oSub1Folder.Path, True


For Each oSubFile In oSub1Folder.Files
wksDest.Cells(iRow, 1) = oSubFile.Name
wksDest.Cells(iRow, 2) = oSubFile.ParentFolder.Path
wksDest.Cells(iRow, 3) = oSubFile.Size / 1000
wksDest.Cells(iRow, 4) = oSubFile.Type
wksDest.Cells(iRow, 5) = oSubFile.DateCreated
wksDest.Cells(iRow, 6) = oSubFile.DateLastModified
wksDest.Cells(iRow, 7) = oSubFile.DateLastAccessed
wksDest.Cells(iRow, 8) = oSubFile.Path


iRow = iRow + 1


Next oSubFile


For Each oSub2Folder In oSub1Folder.SubFolders
ListFilesInFolder oSub2Folder.Path, True


For Each oSub1File In oSub2Folder.Files
wksDest.Cells(iRow, 1) = oSub1File.Name
wksDest.Cells(iRow, 2) = oSub1File.ParentFolder.Path
wksDest.Cells(iRow, 3) = oSub1File.Size / 1000
wksDest.Cells(iRow, 4) = oSub1File.Type
wksDest.Cells(iRow, 5) = oSub1File.DateCreated
wksDest.Cells(iRow, 6) = oSub1File.DateLastModified
wksDest.Cells(iRow, 7) = oSub1File.DateLastAccessed
wksDest.Cells(iRow, 8) = oSub1File.Path


iRow = iRow + 1


Next oSub1File


For Each oSub3Folder In oSub2Folder.SubFolders
ListFilesInFolder oSub3Folder.Path, True


For Each oSub2File In oSub3Folder.Files
wksDest.Cells(iRow, 1) = oSub2File.Name
wksDest.Cells(iRow, 2) = oSub2File.ParentFolder.Path
wksDest.Cells(iRow, 3) = oSub2File.Size / 1000
wksDest.Cells(iRow, 4) = oSub2File.Type
wksDest.Cells(iRow, 5) = oSub2File.DateCreated
wksDest.Cells(iRow, 6) = oSub2File.DateLastModified
wksDest.Cells(iRow, 7) = oSub2File.DateLastAccessed
wksDest.Cells(iRow, 8) = oSub2File.Path


iRow = iRow + 1


Next oSub2File


Next oSub3Folder


Next oSub2Folder


Next oSub1Folder


Next oSubFolder


wksDest.UsedRange.EntireColumn.AutoFit


End Sub
-----------------------------------------------------------------------------------------------------

J'ai un problème au niveau de la sélection des lignes dans Excel puisqu'il me récupère bien je pense tous les noms de fichiers mais pour le dernier dossier scanné, il écrase les premières lignes et insère les noms des fichiers du dernier dossier à la place. (au lieu de me les mettre à la suite...). Il y a certainement un problème avec la gestion de l'indice iRow mais je peine à trouver la solution.
Je suis débutant, veuillez m'excuser par avance si mes questions vous paraissent stupides. 

Merci d'avance pour votre aide.

ljouvenaux · Accepted Answer

Utilise ceci, c'est un peu plus simple et empeche de repeter le meme code 5 ou 6 fois.

Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean)
    Set fs = Application.FileSearch
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wksDest = Worksheets("Listing des Fichiers")
    
    wksDest.Cells(1, 1) = "File name"
    wksDest.Cells(1, 2) = "Parent folder"
    wksDest.Cells(1, 3) = "Size in ko"
    wksDest.Cells(1, 4) = "Type"
    wksDest.Cells(1, 5) = "Date created"
    wksDest.Cells(1, 6) = "Date last modified"
    wksDest.Cells(1, 7) = "Date last accessed"
    wksDest.Cells(1, 8) = "Full path"
    
    With fs
        .LookIn = strFolderName
        .SearchSubFolders = bIncludeSubfolders
        .Filename = "*.*"
        If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set ofile = fso.getfile(.FoundFiles(i))
                wksDest.Cells(i + 1, 1) = ofile.Name
                wksDest.Cells(i + 1, 2) = ofile.ParentFolder.Path
                wksDest.Cells(i + 1, 3) = ofile.Size / 1000 'je laisse 1000, mais c'est mieux 1024 !
                wksDest.Cells(i + 1, 4) = ofile.Type
                wksDest.Cells(i + 1, 5) = ofile.DateCreated
                wksDest.Cells(i + 1, 6) = ofile.DateLastModified
                wksDest.Cells(i + 1, 7) = ofile.DateLastAccessed
                wksDest.Cells(i + 1, 8) = ofile.Path
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With
End Sub

cello3135 · Answer

Merci pour ta réponse ljouvenaux!

Je vais tester cela tout de suite et je reviens pour vous tenir au courant.

cello3135 · Answer

Ca fonctionne très bien. Merci pour ton aide. 

Bonnes fêtes de fin d'année

Problème Macro - Récupération liste fichiers répertoire

3 réponses

Votre réponse

Discussions similaires