[Déplacé VBA - Access] traitement de plusieurs fichiers .txt

Question

Bonjour à tous,

Ce que je cherche à faire : 
j'ai un répertoire (c:\chemin_du_fichier) contenant 130 fichiers .txt ou j'aurais besoin de récuperer le contenu de chaque fichiers .txt afin de les mettre soit dans une table access ou un fichier .csv.
En revanche le contenu de chaque fichiers .txt doit être placé dans autre colonne, c'est à dire 1 fichier = 1 colonne, ce qui devrait donner une table ou fichier .csv de 130 colonnes.
[Si possible (mais c'est moins important car je peux le traiter manuellement et c'est rapide) il faudrais aussi que je puisse mettre le nom de chaques fichiers en entête de colonne.]

Ce que j'ai fait :
J'arrive à récupérer tous le contenu de chaques fichiers, mais malheureusement toutes les données sont copiés dans la même colonne, et moi je me répète mais je voudrais que le contenu de chaques fichiers soit copier dans une colonne différentes.

Voici mon code :

Private Sub Commande8_Click()
Dim strLigne As String
Dim Repertoire, NomFichierTxt_Out, NomFichierTxt_Inp, NomFichierTxt_Dat

Repertoire = "C:\chemin_du_repertoire" 'Repertoire de travail
NomFichierTxt_Out = Repertoire & "Resultat2.csv" 'Fichier à créer
NomFichierTxt_Inp = Repertoire & "Resultat.csv"  'Fichier deja constitué avec les Noms de tous les Fichiers txt

Close 'Fermer tous les fichiers
Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat2.csv
  
Open NomFichierTxt_Inp For Input As #2  'lecture du fichier Resultat.csv
    
    While Not EOF(2)  
       Line Input #2, strLigne 'Lecture de la ligne
       NomFichierTxt_Dat = Repertoire & strLigne 'Nom du fichier de données
       
        Open NomFichierTxt_Dat For Input As #3  'Lecture du fichier de données
        While Not EOF(3)
            Line Input #3, strLigne 'Lecture ligne de donnée
            Print #1, strLigne 'Transfert dans le fichier Resultat2.csv
        Wend
        Close #3 'Fermer Fichier de données       
    Wend
Close 'Fermer tous les fichiers
End Sub


Merci pour l'aide éventuelle que vous pourriez m'apporter !

Utilisateur anonyme · Answer

Bonjour,

C'est parce que l'instruction Lineinput porte bien son nom et lit les fichiers ligne par ligne.

Cela va sans doute allonger le temps d'exécution, mais remplace ton LineInput par un simple Input.

mjpmjp · Answer

bonjour
Structure CSV
un histoire de virgule ?
@+JP

cs_Cercan · Answer

Bonjour,

Ayant résolue mon problème, je vous met ma solution au cas ou ! (peut certainement etre amélioré...mais bon...)


'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::DEBUT RECUPERATION DES GROUPES::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Private Sub btn_traitement_Click()

Dim objFSO, objDossier, objFichier, objResultat
Dim Repertoire, NomFichierTxt

Set objFSO = CreateObject("Scripting.FileSystemObject")
Repertoire = "C:\repertoire"

'Accède au dossier
    If objFSO.FolderExists(Repertoire) Then
        Set oFld = objFSO.GetFolder(Repertoire)
        MsgBox "Dossier des groupes trouvé, en cours de traitements"
    Else
        MsgBox "Ce dossier n'existe pas"
    End If

' extraction de la liste des groupes - utlisateurs
Const ctePourLecture = 1
Const ctePourEcrire = 2
Const ctePourAjouter = 8

  On Error Resume Next
  NomFichierTxt = "Resultat.csv"
  
  Set objDossier = objFSO.GetFolder(Repertoire)
  Set objResultat = objFSO.CreateTextFile(("C:\repertoire" & "" & NomFichierTxt), ctePourEcrire)

    If (objDossier.Files.Count > 0) Then                              'si les fichiers du dossier sont > 0 alors
        For Each objFichier In objDossier.Files                        'pour chaques fichiers du dossier
            If (InStr(1, objFichier.Name, ".txt", 1) > 0) Then          'si la chaine des noms de fichier est > à 0 alors
                objResultat.WriteLine objFichier.Name                   'je créer le fichier et j'ecris les noms de fichiers
            End If
        Next
    End If

objResultat.Close
Set objResultat = Nothing
Set objDossier = Nothing
Set objFSO = Nothing

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::FIN RECUPERATION DES GROUPES::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::DEBUT TRAITEMENT DES UTILISATEURS / GROUPE::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Dim Table_ID(1000, 500) As String
Dim nl As Integer, nc As Integer, MaxL As Integer, MaxC As Integer
Dim strStart As Integer, strStop As Integer
Dim strLigne As String
Dim NomFichierTxt_Out, NomFichierTxt_Inp, NomFichierTxt_Dat ' Repertoire

NomFichierTxt_Out = Repertoire & "Resultat2.csv" 'Fichier à créer
NomFichierTxt_Inp = Repertoire & "Resultat.csv"  'Fichier avec les Noms des Fichiers txt

Close 'Fermer tous les fichiers
'Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat2.csv
  
nc 0: nl 0: MaxL = 0: MaxC = 0
Open NomFichierTxt_Inp For Input As #2  'lecture du fichier Resultat.csv
    
    While Not EOF(2)
    
       Line Input #2, strLigne 'Lecture de la ligne
       NomFichierTxt_Dat = Repertoire & strLigne 'Nom du fichier de données
       
        Open NomFichierTxt_Dat For Input As #3  'Lecture du fichier de données
        While Not EOF(3)
            Line Input #3, strLigne 'Lecture ligne de donnée
            If InStr(1, strLigne, "CN=") > 0 Then
               strStart = InStr(1, strLigne, "CN=") + 3
               strStop = InStr(strStart, strLigne, ",")
               strLigne = Mid(strLigne, strStart, strStop - strStart)
               Table_ID(nl, nc) = strLigne
               nl = nl + 1
            End If
            If nl > MaxL Then MaxL = nl
        Wend
        Close #3 'Fermer Fichier de données
        nl = 0
        nc = nc + 1
    Wend
    MaxC = nc
        Close 'Fermer tous les fichiers
        Open NomFichierTxt_Out For Output As #1 'création du fichier Resultat2.csv
        nc 0: nl 0
            For nl = 0 To MaxL - 1
            For nc = 0 To MaxC - 1
                Write #1, Table_ID(nl, nc),
            Next
                Print #1, ""
            Next
        Close
        MsgBox "Traitements des fichiers effectués"
End Sub
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::FIN TRAITEMENT DES UTILISATEURS / GROUPE::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


Merci à tous et à "Yoda" pour votre aide.

[Déplacé VBA - Access] traitement de plusieurs fichiers .txt

3 réponses

Votre réponse

Discussions similaires