Lister les noms de fichiers d'un repertoire

Sub ListeFichier
  Const ctePourLecture = 1
  Const ctePourEcrire = 2
  Const ctePourAjouter = 8

  Dim objFSO, objDossier, objFichier, objResultat
  Dim Repertoire, NomFichierTxt

  On Error Resume Next

  Repertoire = "C:\Document\Excel"
  NomFichierTxt = "Resultat.txt"
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objDossier = objFSO.GetFolder(Repertoire)
  Set objResultat = objFSO.CreateTextFile((Repertoire & "\" & NomFichierTxt),ctePourEcrire)


  If (objDossier.Files.Count > 0) Then
     For Each objFichier In objDossier.Files
        If (InStr(1, objFichier.Name, ".xls", 1) > 0) Then
            objResultat.WriteLine objFichier.Name
        End If
     Next
   End If

  objResultat.Close
  Set objResultat = Nothing
  Set objDossier = Nothing
  Set objFSO = Nothing

End Sub

Private Sub btn_lister_Click()

    Dim monRep As Variant
    Dim ext As String, Ctr As Integer
    
    ext = ""
    monRep = Me.edit_repertoire.Value
    
    
    ext = Dir(monRep & "\*.doc")
    List_rep.Visible = True
    List_rep.DefaultValue = ""
    Do While ext <> ""
        Me.List_rep.AddItem ext
        ext = Dir
    Loop
    'List_rep.ListStyle = fmListStyleOption

End Sub
'

Option Compare Database

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Enum NetWork
    WithNetworkFolders = 0
    WithoutNetworkFolders = 2
End Enum

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
    ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
    As Long
    
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_USENEWUI = &H40

Private Sub btn_parcourir_Click()

    Me.edit_repertoire = SelectFolder("D:\", WithoutNetworkFolders)
    
    If IsNull(edit_repertoire) Or Len(edit_repertoire) = 0 Then
        btn_lister.Visible = False
    Else
        btn_lister.Visible = True
    End If
    
End Sub

Public Function SelectFolder(Optional Folder As String = "" _
           , Optional NetWorkFolders As NetWork = WithNetworkFolders _
           ) As String
    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer
    If Folder = "" Then Folder = CurrentProject.Path
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = "Sélectionnez votre dossier et cliquez sur OK"
        .ulFlags = BIF_RETURNONLYFSDIRS _
            Or BIF_USENEWUI _
            Or NetWorkFolders
    End With
    dwIList = SHBrowseForFolder(bi)
    szPath = Folder & Space$(512 - Len(Folder))
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If X Then
        wPos = InStr(szPath, Chr(0))
        SelectFolder = Left$(szPath, wPos - 1)
    Else
        SelectFolder = ""
    End If
End Function

Private Sub edit_repertoire_Change()
    
    If IsNull(edit_repertoire.Text) Or Len(edit_repertoire.Text) = 0 Then
        btn_lister.Visible = False
    Else
        btn_lister.Visible = True
    End If
End Sub

Private Sub btn_lister_Click()

    Dim ext As String
    Dim Ctr As Integer
    Const myRep = "edit_repertoire.Text" ' Voir s'il ne faut pas definir repertoire...
    
    ext = Dir(myRep & "*.doc")
    List_rep.Visible = True
    List_rep.DefaultValue = ""
    Do While ext <> ""
        List_rep.ControlSource = ext
        ext = Dir
    Loop
   
   List_rep.ListStyle = fmListStyleOption
        
    Next
End Sub

Private Sub btn_lister_Click()

    Dim ext As String
    Const myRep = "edit_repertoire.Text" ' Voir s'il ne faut pas definir repertoire...
    
    ext = Dir(myRep & "*.doc")
    List_rep.RowSource = ""
    'Do While ext <> ""
        'List_rep.RowSource = List_rep.RowSource & ext & ";"
        'ext = Dir
    Loop
   
   'List_rep.ListStyle = fmListStyleOption
        
    
End Sub