ouvrir fichiers d'après une liste

Sub ReadTxtFiles()
Dim st() As String
Dim i As Integer
Dim fso As Object, fld As Object, fl As Object, ftxt As Object
Set fso = CreateObject('scripting.filesystemobject')
Set fld = fso.getfolder('C:[Backslash]\\MonDossier[Backslash]')
For Each fl In fld.Files
    ReDim st(0)
    st(0) = fl.Path
    If LCase(fso.getextensionname(st(0))) = 'txt' Then
        Set ftxt = fso.opentextfile(st(0), 1)
        While Not ftxt.AtEndOfStream
            ReDim Preserve st(UBound(st) + 1)
            st(UBound(st)) = ftxt.readline
        Wend
    End If
    For i = 1 To UBound(st)
        st(0) = st(0) & vbCrLf & st(i)
    Next i
    MsgBox st(0)
Next fl
Set fso = Nothing: Set fld = Nothing: Set fl = Nothing: Set ftxt = Nothing
End Sub