Lister les noms de fichiers d'un repertoire

Private Sub btn_lister_Click()

    Dim ext As String
    Dim myRep As String
    
    myRep = edit_repertoire.Value
    
    ext = Dir(myRep & "\*.doc")
    List_rep.Visible = True
    List_rep.RowSource = ""
    Do While ext <> ""
        List_rep.RowSource = List_rep.RowSource & ext & ";"
        ext = Dir
    Loop
   
   'List_rep.ListStyle = fmListStyleOption
    
End Sub

List_rep.RowSource = ""

Private Sub btn_parcourir_Click()

    Me.edit_repertoire = SelectFolder("D:\", WithoutNetworkFolders)
          
    If Not (IsNull(edit_repertoire) Or Len(edit_repertoire) = 0) Then
        Mise_A_Jour_Liste
    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 cmd_Quitter_Click()
    DoCmd.Close
End Sub
'

Private Sub edit_repertoire_Change()
          
    If Not (IsNull(edit_repertoire.Text) Or Len(edit_repertoire.Text) = 0) Then
        Mise_A_Jour_Liste
    End If
    
End Sub
'

Private Sub Form_Load()

    Me.typ_fichier.AddItem "*.doc"
    Me.typ_fichier.AddItem "*.xls"
    Me.typ_fichier.AddItem "*.pdf"
    Me.typ_fichier.AddItem "*.txt"
    Me.typ_fichier.AddItem "*.*"
    
    If Not (IsNull(edit_repertoire) Or Len(edit_repertoire) = 0) Then
        Mise_A_Jour_Liste
    End If
    
    
End Sub
'

Private Sub typ_fichier_AfterUpdate()
    Mise_A_Jour_Liste
End Sub
'

Private Sub Mise_A_Jour_Liste()

    Dim monRep As Variant, monType As Variant
    Dim ext As String, Ctr As Integer
    
    While Me.List_rep.ListCount > 0
        Me.List_rep.RemoveItem (Me.List_rep.ListCount - 1)
    Wend
    
    ext = ""
    monRep = Me.edit_repertoire.Value
    monType = Me.typ_fichier.Value
    
    ext = Dir(monRep & "\" & monType)
    List_rep.Visible = True
    List_rep.DefaultValue = ""
    Do While ext <> ""
        Me.List_rep.AddItem ext
        ext = Dir
    Loop

End Sub

Private Sub btn_lister_Click()

    Dim ext As String
    Dim myRep As String
    
    myRep = edit_repertoire.Value
    
    ext = Dir(myRep & "\*.doc")
    List_rep.Visible = True
    Do While ext <> ""
        List_rep.AddItem (myRep & "\" & ext)
        ext = Dir
    Loop
    
End Sub

Private Sub btn_lister_Click()

    Mise_A_Jour_Liste
    
End Sub

Private Sub List_Rep_Click()

    Dim Control_Liste As Control, Fichier_Item As Variant
    Dim Contenu As String
    
    Contenu = ""
    Set Control_Liste = Forms!CheminDAcces.List_rep
    For Each Fichier_Item In Control_Liste.ItemsSelected
        Contenu = Contenu & vbCrLf & Control_Liste.ItemData(Fichier_Item)
    Next Fichier_Item
    MsgBox Contenu

End Sub
'

'      mon bouton parcourir :

Private Sub btn_parcourir_Click()

    Me.edit_repertoire = SelectFolder("D:\", WithoutNetworkFolders)
          
    If Not (IsNull(edit_repertoire) Or Len(edit_repertoire) = 0) Then
        Mise_A_Jour_Liste
    End If
          
End Sub
'

Private Sub cmd_Quitter_Click()
    DoCmd.Close
End Sub
'

Private Sub edit_repertoire_Change()
          
    If Not (IsNull(edit_repertoire.Text) Or Len(edit_repertoire.Text) = 0) Then
        Mise_A_Jour_Liste
    End If
    
End Sub
'

Private Sub Form_Load()

    Me.typ_fichier.AddItem "*.doc"
    Me.typ_fichier.AddItem "*.xls"
    Me.typ_fichier.AddItem "*.pdf"
    Me.typ_fichier.AddItem "*.txt"
    Me.typ_fichier.AddItem "*.*"
    
    If Not (IsNull(edit_repertoire) Or Len(edit_repertoire) = 0) Then
        Mise_A_Jour_Liste
    End If
    
    
End Sub
'

Private Sub typ_fichier_AfterUpdate()
    Mise_A_Jour_Liste
End Sub
'

Private Sub Mise_A_Jour_Liste()

    Dim monRep As Variant, monType As Variant
    Dim ext As String, Ctr As Integer
    
    While Me.List_rep.ListCount > 0
        Me.List_rep.RemoveItem (Me.List_rep.ListCount - 1)
    Wend
    
    ext = ""
    monRep = Me.edit_repertoire.Value
    monType = Me.typ_fichier.Value
    
    ext = Dir(monRep & "\" & monType)
    List_rep.Visible = True
    List_rep.DefaultValue = ""
    Do While ext <> ""
        Me.List_rep.AddItem ext
        ext = Dir
    Loop

End Sub

Private Sub btn_convertir_Click()
    Dim reponse As Integer
    Dim fso As Object
    Dim rep As String
    Dim fname As String
    Dim RepExist As Boolean
GetDir:
    rep = InputBox("Veuillez entrer le répértoire de destination", "Répértoire de Destination", edit_repertoire & "\convertion\")
    Set fso = CreateObject("Scripting.FileSystemObject")
    RepExist = fso.FolderExists(rep)
    Do While Not RepExist
        reponse = MsgBox("Le répértoire cité n'existe pas ! Voulez-vous le créer ?", vbYesNoCancel + vbQuestion, "création répértoire")
        If reponse = vbYes Then
            MkDir (rep)
            Exit Do
        ElseIf vbCancel Then
            Exit Sub
        Else
           GoTo GetDir
        End If
    Loop
    For i = 0 To List_rep.ListCount - 1
         If List_rep.Selected(i) Then
            k = InStr(List_rep.List(i), ".")
            fname = Left(List_rep.List(i), k - 1)
            objWord.Documents.Open List_rep.Selected(i) ' ouvrir un document Word
            ActiveDocument.SaveAs FileName:=fname & ".rtf", FileFormat:=wdFormatRTF
            objWord.Documents(1).Close  ' fermer le document
            objWord.Quit ' quitter l'application Word
            Set objWord = Nothing  ' libérer la mémoire
         End If
    Next i
    
End Sub

objWord.Documents(1).Close  ' fermer le document