XL 2019 Contenu de répertoire affiché dans feuille

MarcDJ

XLDnaute Junior
Bonjour,

J'aimerais, d'une façon simple, ouvrir un répertoire et afficher son contenu dans la colonne d'une feuille.

Avec un méthode FileSystemOject j'arrive à ouvrir mon répertoire, à afficher le contenu dans ma fenêtre d'exécution,
Mais je voudrais que cela s'affiche dans une colonne de ma feuille Excel.

VB:
Sub Obtenir_Nom_SousRepertoire()

'Afficher le nom des sous-repertoires de repertoire

Dim MyFSO As FileSystemObject
Dim MyFolder As Folder
Dim MyFile As File
Dim MySubfolder As Folder

Set MyFSO = New FileSystemObject
Set MyFolder = MyFSO.GetFolder("D:\Test")

For Each MySubfolder In MyFolder.SubFolders 'Pour chaque sous-repertoire
    Debug.Print MySubfolder.Name 'Afficher le nom du sous-repertoire "D:\Test"
Next MySubfolder 'Fermer la boucle

End Sub

Merci d'avance pour vos réponses.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour MarcDJ,
Un exemple en PJ, il suffit de rentrer en B4 le chemin du dossier à analyser. la liste est crée avec :
VB:
Sub ListingFichiers()
' Liste les fichiers présent dans Rep et les rentre dans la Liste.
' La liste commence à l'indice 1 pour faire plus simple ( donc Liste(0) est vide )
Dim Rep As String, Fichier As String, i As Integer, Liste(1000), DateFile(1000)
On Error GoTo Fin
i = 0
[FileListe].ClearContents
[TypeFile].ClearContents
[DateCreationDir].ClearContents

Rep = [Directory]
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"    ' Le nom doit se terminer par \

Fichier = Dir(Rep)

Do While Fichier <> ""
    i = i + 1
    Liste(i) = Fichier
    DateFile(i) = Int(FileDateTime(Rep & Fichier)) ' Enregistre la date de création du fichier ( en type date )
    Fichier = Dir
    [FileListe].Cells(i, 1) = Fichier
    [DateCreationDir].Cells(i, 1) = FileDateTime(Rep & Fichier)
Loop
Fin:
End Sub
 

Pièces jointes

  • Liste fichiers d une directory V2.xlsm
    25.3 KB · Affichages: 11

job75

XLDnaute Barbatruc
Bonsoir MarcDJ, sylvanu,

On ne sait pas trop ce que vous voulez mais exécutez ces 2 macros :
VB:
Sub ListeDossiers()
Dim chemin$, col%, lig&, fso As Object, sf As Object
'chemin = "D:\Test"
chemin = ThisWorkbook.Path 'c'est mieux pour tester
col = 1 'colonne A
lig = 1 '1ère ligne de destination, à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Cells(lig, col) = "Sous-dossiers": Cells(lig, col).Font.Bold = True 'gras
For Each sf In fso.getfolder(chemin).subfolders
    lig = lig + 1
    Cells(lig, col) = sf.Name
Next
Cells(lig + 1, col).Resize(Rows.Count - lig).ClearContents 'RAZ en dessous
Columns(col).AutoFit 'ajuste la largeur
End Sub

Sub ListeFichiers()
Dim chemin$, col%, lig&, fichier$
'chemin = "D:\Test"
chemin = ThisWorkbook.Path & "\" 'c'est mieux pour tester
col = 2 'colonne B
lig = 1 '1ère ligne de destination, à adapter
fichier = Dir(chemin) '1er fichier du dossier
Application.ScreenUpdating = False
Cells(lig, col) = "Fichiers": Cells(lig, col).Font.Bold = True 'gras
While fichier <> ""
    lig = lig + 1
    Cells(lig, col) = fichier
    fichier = Dir 'fichier suivant
Wend
Cells(lig + 1, col).Resize(Rows.Count - lig).ClearContents 'RAZ en dessous
Columns(col).AutoFit 'ajuste la largeur
End Sub
A+
 

MarcDJ

XLDnaute Junior
Re sylvanu, job75,

Je suis perdu avec votre façon de coder.

Je comprends la déclaration des variables mais je ne vois pas quel type de variable pour col et lig.

Je comprends également ce que vous voulez faire, mais je voudrais le retranscrire avec ma façon de coder en travaillant avec FileSystemObject.

Sinon je n'apprendrai rien, je ne ferai que recopier du code, je voudrais vraiment comprendre le code
et avoir une même ligne de conduite pour y arriver.

Je sais que c'est un peu laborieux pour vous avec les débutants et je m'en excuse d'avance.

Je vais commencer à retranscrire le code et voir où cela me mène.

Un grand merci pour votre aide.
 

dysorthographie

XLDnaute Accro
bonjour,
VB:
Sub Obtenir_Nom_SousRepertoire()

'Afficher le nom des sous-repertoires de repertoire

Dim FSO As Object, L As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
L = 1
 ThisWorkbook.Sheets("Feuil1").Cells.Clear
 ThisWorkbook.Sheets("Feuil1").Range("A1") = "Myrep"
MyRep FSO, ThisWorkbook.Sheets("Feuil1"), "C:\Myrep", L + 1, 2

End Sub
Sub MyRep(ByVal FSO As Object, ByRef feuille As Worksheet, ByVal Rep As String, ByRef L As Integer, Optional C As Integer = 1)
With FSO.GetFolder(Rep)
    For Each MySubfolder In .SubFolders 'Pour chaque sous-repertoire
      feuille.Cells(L, C) = MySubfolder.Name 'Afficher le nom du sous-repertoire "D:\Test"
      L = L + 1
     MyRep FSO, feuille, MySubfolder.Path, L, C + 1
    Next
    
   If C > 1 Then MyFichier FSO, feuille, Rep, L, C
End With

C = C - 1

 If C > 0 Then feuille.Cells(L, C) = "Fin " & IIf(Right(Rep, 1) = "\", Split(Rep, "\")(UBound(Split(Rep, "\")) - 1), Split(Rep, "\")(UBound(Split(Rep, "\")))): L = L + 1
End Sub
Sub MyFichier(ByVal FSO As Object, ByRef feuille As Worksheet, ByVal Rep As String, ByRef L As Integer, ByVal C As Integer)
With FSO.GetFolder(Rep) 'Liste les fichiers du répertoire
        For Each NomFich In .Files
            feuille.Cells(L, C) = NomFich.Name
      L = L + 1
        Next
    End With
End Sub
 

dysorthographie

XLDnaute Accro
Regardes la SUB myrep c'est bien le même code que toi ? Non?
Code:
For Each MySubfolder In .SubFolders 'Pour chaque sous-repertoire
      feuille.Cells(L, C) = MySubfolder.Name 'Afficher le nom du sous-repertoire "D:\Test"
      L = L + 1
     MyRep FSO, feuille, MySubfolder.Path, L, C + 1
    Next
 

MarcDJ

XLDnaute Junior
Re dysorthographie,

Cela je peux éventuellement comprendre, mais la ligne au dessus je n'y comprend rien.

Je sais qu'il me manque beaucoup en codage, je viens d'apprendre :


Et rien ne correspond au codage que vous me monter, j'ai l'impression que cela ne m'a servi à rien.

Où, puis-je apprendre tout cela, mais 1 seule façon de coder.

Merci.
 
Dernière édition:

dysorthographie

XLDnaute Accro
et comme ça on est à l'identique?
Code:
Sub Obtenir_Nom_SousRepertoire()

'Afficher le nom des sous-repertoires de repertoire

Dim MyFSO As FileSystemObject
Dim MyFolder As Folder
Dim MyFile As File
Dim MySubfolder As Folder

Set MyFSO = New FileSystemObject
Set MyFolder = MyFSO.GetFolder("D:\Test")
Dim Ligne As Integer
For Each MySubfolder In MyFolder.SubFolders 'Pour chaque sous-repertoire
    Debug.Print MySubfolder.Name 'Afficher le nom du sous-repertoire "D:\Test"
    Range("A1").Offset(Ligne) = MySubfolder.Name  'Afficher le nom du sous-repertoire "D:\Test" dans les cellules A1:AXXX
   Ligne = Ligne + 1
Next MySubfolder 'Fermer la boucle

End Sub
 
Dernière édition:

Discussions similaires

Réponses
19
Affichages
2 K