Liste fichier sous Excel - Problème dans le code

Option Explicit
Private Sub CommandButton1_Click()
ListeTest
End Sub
Sub ListeTest()
Dim repertoire, nf As String
Dim i As Integer
repertoire = "T:\DossierTest" 
' DossierTest comprenant 2 fichiers. un pdf et un word
i = 4
nf = Dir(repertoire & "\*")
Do While nf <> ""
Cells(i, 7) = nf
nf = Dir
i = i + 1
Loop
End Sub

Sub ListeTest()
Dim repertoire, nf As String
Dim i As Integer
repertoire = "chemin dossier"
' DossierTest comprenant 2 fichiers. un pdf et un word
i = 4
nf = Dir(repertoire & "\*.*")
Do While nf <> ""
Cells(i, 7) = nf
nf = Dir
i = i + 1
Loop
End Sub

' Liste les fichiers d'un dossier et de ses sous dossiers
' dans une feuille de calcul avec certains renseignements
' d'après Ole P Erlandsen
' code original à cette adresse http://www.erlandsendata.no/)

Sub TestListFilesInFolder()
Dim RootFolder$

  ' dossier à scanner
  RootFolder = ChoisirDossier
  If RootFolder = "" Then Exit Sub
  
  ' create a new workbook for the file list
  Workbooks.Add
 ' add headers
  With Range("A1")
    .Formula = " Contenu du dossier : " & RootFolder
    .Font.Bold = True
    .Font.Size = 12
    .Font.Color = RGB(255, 0, 0)
  End With

  Range("A3").Formula = "Chemin : "
  Range("B3").Formula = "Nom : "
  Range("C3").Formula = "Date Création : "
  Range("D3").Formula = "Date Dernier Accès : "
  Range("E3").Formula = "Date Dernière Modif : "
  Range("F3").Formula = "Taille Fichier: "
  With Range("A3:F3")
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = True
    .Font.Color = RGB(0, 0, 255)
  End With
  
  ' list all files included subfolders
  ListFilesInFolder RootFolder, True
  
  Columns("A:H").AutoFit

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName", True
' Ole P Erlandsen (modifié fs 11/8/01)

Dim fso 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim SubFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim R As Long

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = fso.GetFolder(SourceFolderName)
  R = Range("A65536").End(xlUp).Row + 1

  For Each FileItem In SourceFolder.Files
 
    ' display file properties
   Cells(R, 1).Formula = FileItem.ParentFolder
    Cells(R, 2).Formula = FileItem.Name
    Cells(R, 3).Formula = FileItem.DateCreated
    Cells(R, 3).NumberFormat = "ddd* yyyy-mm-dd hh:mm:ss"
    Cells(R, 4).Formula = FileItem.DateLastAccessed
    Cells(R, 5).Formula = FileItem.DateLastModified
    Cells(R, 5).NumberFormat = "ddd* yyyy-mm-dd hh:mm:ss"
    Cells(R, 6).Formula = FileLen(FileItem) & " octets"
    ' next row number
 R = R + 1
  Next FileItem

  If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.subfolders
      ListFilesInFolder SubFolder.path, True
    Next SubFolder
  End If

  Set FileItem = Nothing
  Set SourceFolder = Nothing
  Set fso = Nothing

  ActiveWorkbook.Saved = True

End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, Chemin, SecuriteSlash
                                            
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = _
        objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
    On Error Resume Next
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
    If objFolder.Title = "Bureau" Then
        Chemin = "C:\Windows\Bureau"
    End If
    If objFolder.Title = "" Then
        Chemin = ""
    End If

    SecuriteSlash = InStr(objFolder.Title, ":")

    If SecuriteSlash > 0 Then
        Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
    End If
    ChoisirDossier = Chemin
End Function

Private Sub CommandButton1_Click()
TestListFilesInFolder
End Sub