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

cello3135 12 Messages postés jeudi 14 décembre 2006Date d'inscription 3 janvier 2007 Dernière intervention - 29 déc. 2006 à 11:05 - Dernière réponse : cello3135 12 Messages postés jeudi 14 décembre 2006Date d'inscription 3 janvier 2007 Dernière intervention
- 29 déc. 2006 à 14:15
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.
Afficher la suite 

Votre réponse

3 réponses

Meilleure réponse
ljouvenaux 5 Messages postés mardi 29 avril 2003Date d'inscription 29 décembre 2006 Dernière intervention - 29 déc. 2006 à 12:07
3
Merci
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

Merci ljouvenaux 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de ljouvenaux
Meilleure réponse
cello3135 12 Messages postés jeudi 14 décembre 2006Date d'inscription 3 janvier 2007 Dernière intervention - 29 déc. 2006 à 14:01
3
Merci
Merci pour ta réponse ljouvenaux!

Je vais tester cela tout de suite et je reviens pour vous tenir au courant.

Merci cello3135 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de cello3135
cello3135 12 Messages postés jeudi 14 décembre 2006Date d'inscription 3 janvier 2007 Dernière intervention - 29 déc. 2006 à 14:15
0
Merci
Ca fonctionne très bien. Merci pour ton aide.

Bonnes fêtes de fin d'année
Commenter la réponse de cello3135

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.