CONCATÉNATION AVEC FSO

Option Explicit
Private Sub Form_Load()
  Concaténation
  End
End Sub
Private Sub Concaténation()
  Dim WkDir As String, S As String
  Dim fsO As Object
  Dim fsF As Object
  Dim fsN As Object
  Dim fsT As Object
  Dim fsW As Object
' Préparer un message pour la fin
  S = "Concaténation des fiches:" & vbCr
' Partir FSO
  Set fsO = CreateObject("Scripting.FileSystemObject")
' Recueillir l'endroit du disque dur où nous sommes
  WkDir = App.Path
' Ouvrir GrosText, la fiche de la concaténation
  Set fsW = fsO.opentextfile(WkDir & "\GrosText", 2, True)
' Recueillir les noms des fiches dans WkDir
  Set fsF = fsO.GetFolder(WkDir).Files
' Trier les fiches
  For Each fsN In fsF
'   Choisir celles qui sont .txt
    If Right(fsN.Name, 3) = "txt" Then
'     Ajouter le nom de la fiche à notre Message Pour La Fin
      S = S & fsN.Name & vbCr
'     L'ouvrir
      Set fsT = fsO.opentextfile(WkDir & "\" & fsN.Name, 1)
'     Écrire une ligne contenant le nom de .txt pour séparer chaque fiche dans GrosText
      fsW.writeline ("")
      fsW.writeline ("############### Début de la fiche " & fsN.Name & " ###############")
      fsW.writeline ("")
'     Copier dans GrosText chaque ligne de .txt
      Do While Not fsT.atendofstream
        fsW.writeline (fsT.readline)
      Loop
'Vous pouvez insérer la fiche d'un seul coup
'avec le suivant:  fsW.write (fsT.readall)
'     Fermer la fiche .txt
      fsT.Close
    End If
  Next fsN
' Fermer GrosText
  fsW.Close
  MsgBox S, , "La Fiche GrosText"
  Set fsO = Nothing
  Set fsF = Nothing
  Set fsN = Nothing
  Set fsT = Nothing
  Set fsW = Nothing
End Sub