Concaténation avec fso

Commenter

Contenu du snippet

Un logiciel qui fait la concaténation de tous les fiches .txt du
répertoire dans une grosse fiche qu'on appelle GrosText.

Vous assurer que dans l'endroit du disque dur où vous travaillez,
il y a des fiches format .txt et qu'elles ne sont ni trop nombreuses,
ni trop grandes!

N'oubliez pas à la fin d'effacer GrosText de votre disque dur.

Insérez le code dans la forme d'un nouveau projet VB6.

Visitez mon site!!!: http://www.cyberbeach.net/~loudelon

Source / Exemple : 


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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Louis)