Lister les présents dans un dossier

Bonjour à tous,

J'ai trouvé cette macro sur internet, qui permet de lister tous les fichiers présents dans un dossier :

Sub listfiles()
'Updateby Extendoffice
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)

    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next

End Sub

En lançant cette macro, il suffit d'indiquer le dossier cible, et tous les fichiers sont lister en ligne.

Afin de l'optimiser, j'aimerais simplement définir un dossier fixe. Du style C:/Mes documents.

Au lieu de devoir pointer le dossier.

Pouvez-vous m'aider ?

Merci par avance!

Cdt

Bonjour,

Option Explicit

Sub ListFiles()

Dim I As Integer
Dim xFSO As Object, xFolder As Object, xFile As Object

    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder("C:\Documents")

    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next

    Set xFSO = Nothing: Set xFolder = Nothing

End Sub

Bonjour, ci-après deux macros : l'une pour la liste des "fichiers" l'autre pour la liste des "répertoires".

Ils utilisent l'adresse du fichier excel "Thisworkbook.path" vous pouvez donc personnaliser à votre guise.

Sub Fichiers()

Application.ScreenUpdating = False
Dim myPath As String, myFile As String

myPath = ThisWorkbook.Path
myFile = Dir(myPath & "\*.*")

'La liste sera créée en colonne B de la feuille actuelle
c = 2
Do While myFile <> ""
    Cells(c, 2) = myFile
    myFile = Dir()
    c = c + 1
Loop

End Sub

Sub Dossiers()

Application.ScreenUpdating = False
Dim myPath As String, myFolder As String

myPath = ThisWorkbook.Path
myFolder = Dir(myPath & "\*", vbDirectory)
'La liste sera créée en colonne A de la feuille actuelle
c = 2
Do While myFolder <> ""

    If GetAttr(myPath & "\" & myFolder) = vbDirectory Then
        Cells(c, 1) = myFolder
        c = c + 1
    End If
    myFolder = Dir()

Loop
End Sub

Merci à tous les deux !

Testées, approuvées Résolu

Cordialement