Macro concaténation de fichier

M6sou Messages postés 71 Statut Membre -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
Salut à tous et à toutes,
Voilà, actuellement je travail sur projet de base de données. Néanmoins, avant de l'attaquer, je devais trier et concaténer des fichiers logs. Sur les conseils d'une personnes, après avoir réaliser ma macro de tir des fichiers, je les ai enregistré en .csv. J'ai donc désormais des fichiers de cette forme là Tss_dataJJMMAAHHMM.log.csv :
Tss_data0102130800.log.csv
Tss_data0102130856.log.csv
Tss_data0506131625.log.csv

J'en ai environ 3000 sur 3 ans, et il peut y avoir plusieurs fichiers par jours. D'où mon problème. Je dois maintenant trouver une solution afin de concaténer ces fichiers .csv .
J'aimerais donc une macro me permettant de dire :
-Prend les fichiers ayant les 14 premiers caractères (Tss_dataJJMMAA) identiques;
-Concaténe les;
-Enregistre le au même nom;
-Et réitère l'opération jusqu'au dernier fichier.

Je ne viens pas les mains vident of course, j'ai déjà réussis la concaténation de tout les fichiers d'un dosiers ainsi que son enregistrement. Il ne manque que la partie "par nom de fichier" que je galère pas mal . 

Option Explicit

Sub importDonnees()
    Dim principal As ThisWorkbook
    Dim repertoire As String, Fichier$
    Application.ScreenUpdating = False
    Set principal = ThisWorkbook
    repertoire = "C:\Documents and Settings\9403095F\Bureau\Test_Macro\"
    Fichier = Dir(repertoire & "*.csv")
    
    If "Date1" Like "Date2" Then
    
    Do While Fichier <> ""
        Workbooks.Open (repertoire & Fichier)
        ActiveSheet.UsedRange.Copy Destination:=principal.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1)
        ActiveWorkbook.Close
        Fichier = Dir
    Loop
        
    ChDir "C:\Documents and Settings\9403095F\Bureau\Test_Macro\Nouveau\"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\9403095F\Bureau\Test_Macro\Nouveau\Finale.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=True
    End If

End Sub
Merci d'avance pour vos réponse,
Bonne journée !!

4 réponses

  1.
    M6sou Messages postés 71 Statut Membre
     
    Le code précédent est incomplet.
    Petite mise à jour. Après avoir fait pas mal de recherches, j'ai opté pour une solution.
    Mon idée est la suivante:
    Etant donnée que tout les noms de fichiers ont la même structure, et que ce qui m'intéresse est la date, j'ai décidé de prendre le milieu du nom de fichier et de les comparer entre eux.
    Pour ce faire, j'ai écris le code suivant : 

    Option Explicit

    Sub importDonnees()
       Dim principal As ThisWorkbook    
       Dim repertoire As String
        Dim NomFichierActif As String
        Dim DateActiveP As String
        Dim DateActive As String
        Dim Init As Boolean
        
        Application.ScreenUpdating = False
        Set principal = ThisWorkbook
        repertoire = "C:\Documents and Settings\...\Bureau\Test_Macro\"
        NomFichierActif = Dir(repertoire & "*.csv")
        Init = True
        Do While NomFichierActif <> ""
            DateActive = Mid(NomFichierActif, 9, 6) ' Prendre la date 1 sur le nom d'un fichier                 
                If DateActiveP = DateActive Then ' Comparer date 1 et date 2   
     Workbooks.Open (repertoire & NomFichierActif) ' copie               
     ActiveSheet.UsedRange.Copy Destination:=principal.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) ' copie                ActiveWorkbook.Close True
                    NomFichierActif = Dir
                    DateActiveP = DateActive ' mettre la date 1 dans la date 2                Init = False
                    ChDir "C:\Documents and Settings\9403095F\Bureau\Test_Macro\Nouveau\"
                
            End If
        Loop
    End Sub

    Néanmoins, le programme ne fonctionne pas (sinon je ne serais pas là je pense :D). Il semblerait qu'il bloque au lignes suivante (en gras dans le programme) :
    Workbooks.Open (repertoire & NomFichierActif) ' copie ActiveSheet.UsedRange.Copy Destination:=principal.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1) ' copie

    Merci pour vos réponses et aide,
    Bonne journée !
    0
  2. M6sou Messages postés 71 Statut Membre
     
    Personne ?
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour, 

    repertoire = "C:\Documents and Settings\...\Bureau\Test_Macro\"

    le chemin doit etre complet
    0
    1. M6sou Messages postés 71 Statut Membre
       
      Dans mon programme le chemin est complet là j'ai juste mis des "..." par fainéantise de tout mettre :)
      0
  4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    une facon differente de faire:

    principe:
    deux objets Dictionary , Dico1 pour mise en memoire Date et les noms de fichiers meme date, Dico2 date et nombre de fichiers meme date (je pense qu'il et possible de faire avec un seul avec la valeur de clef)

    commande Dos (ici pour deux fichiers):
    copy chemin & Fichier1 + chemin & fichier2 chemin & fichierFinal

    pensez a mettre votre ou vos repertoires 

    Option Explicit
    '--------------------------- API attente en ms ---------------------------------------------------------
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    '-------------------------------------------------------------------------------------------------------------

    Sub concat_fichier()
        Dim repertoire As String
        Dim NomFichierActif As String
        Dim FDate As String
        Dim TFichier, point As Integer, FFichier, retval
        Dim Dico1, Dico2, curKey, sConcat
        
        Application.ScreenUpdating = False
        Set Dico1 = CreateObject("Scripting.Dictionary")
        Set Dico2 = CreateObject("Scripting.Dictionary")
        'repertoire a adapter
        repertoire = "D:\_ACSV\"
        NomFichierActif = Dir(repertoire & "*.csv")
        Do While NomFichierActif <> ""
            If Left(NomFichierActif, 4) = "Tss_" Then
                'liste fichiers, date
                FDate = Mid(NomFichierActif, 9, 6)
                'liste Date
                If Not Dico2.Exists(FDate) Then
                    Dico2.Add FDate, 1
                    Dico1.Add FDate, NomFichierActif
                Else
                    'compteur NbFichier meme date
                    Dico2.Item(FDate) = Dico2.Item(FDate) + 1
                    'rang cle en cours
                    point = Application.Match(FDate, Dico1.keys, 0)
                    'ajout fichiers meme date
                    Dico1.Item(FDate) = Dico1.Item(FDate) & "-" & NomFichierActif
                End If
            End If
            NomFichierActif = Dir
        Loop
        'boucle sur Dico2 pour concatenation fichiers mem date
        For Each curKey In Dico2
            If Dico2.Item(curKey) > 1 Then      'test si plusieurs fichiers meme date
                'mise en tableau des noms de fichier
                TFichier = Split(Dico1.Item(curKey), "-")
                'nom de fichier final
                FFichier = Left(TFichier(0), 14) & ".CSV"
                'Chaine de commande DOS pour concatenation fichier
                sConcat = "cmd /c Copy " & repertoire
                'boucle fichier -1
                point = UBound(TFichier)
                For point = 0 To point - 1
                    'ajout fichier
                    sConcat = sConcat & TFichier(point) & "+" & repertoire
                Next
                'aout dernier fichier
                sConcat = sConcat & TFichier(point)
                'ajout nom de fichier final
                sConcat = sConcat & " " & repertoire & FFichier
                'commande shell
                retval = Shell(sConcat, vbMinimizedNoFocus)
                'attente: ici 200ms, peut etre remplace par ctrl process shell (a voir)
                Sleep 200
            End If
        Next curKey
        Application.ScreenUpdating = True
    End Sub

    Question: pourquoi passer par une conversion CSV ???????
    Les fichiers de log sont des fichiers texte
    0
    1. M6sou Messages postés 71 Statut Membre
       
      Salut f894009, merci pour ta réponse et désolez pour le temps qu'aura mise la mienne.
      Pour l'histoire de la conversion, elle n'est pas obligatoire pour finir.

      Merci pour le programme, j'ai exécuté le programme, en y remplaçant mon répertoire, mais je ne comprends pas une chose :
      Où s'enregistre les fichiers finaux ? Car quand je lance le code, je vois bien la fenêtre de cmd s'ouvrir et se fermer rapidement, et travailler mais je ne trouve pas les fichiers de sortie...

      Saurez tu où ils se trouvent ?
      0
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Je n'avais qu'un seul repertoire:
       repertoire = "D:\_ACSV\"

      utilise ici: 
      NomFichierActif = Dir(repertoire & "*.csv")

      et

      ici: 
      sConcat = sConcat & " " & repertoire & FFichier

      a vous de voir ce que vous avez mis comme repertoires
      0
    3. M6sou Messages postés 71 Statut Membre
       
      Oui pour ça je suis d'accord, j'ai mis mon repertoire, le programme tourne bien, mais je ne trouve pas mes fichiers de sorties (fichiers concaténés) ... Ils ne s'enregistrent pas dans le même répertoire
      0
    4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Mettez votre code a dispo svp
      0
    5. M6sou Messages postés 71 Statut Membre
        
      Option Explicit
'--------------------------- API attente en ms ---------------------------------------------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'-------------------------------------------------------------------------------------------------------------
Sub concat_fichier()
Dim repertoire As String
Dim NomFichierActif As String
Dim FDate As String
Dim TFichier, point As Integer, FFichier, retval
Dim Dico1, Dico2, curKey, sConcat
Application.ScreenUpdating = False
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")    'repertoire a adapter
NomFichierActif = Dir(repertoire & "*.txt")
repertoire = "C:\Documents and Settings\9403095F\Bureau\Test\"
Do While NomFichierActif <> ""
If Left(NomFichierActif, 4) = "Tss_" Then            'liste fichiers, date
FDate = Mid(NomFichierActif, 9, 6)            'liste Date
If Not Dico2.Exists(FDate) Then
Dico2.Add FDate, 1
Dico1.Add FDate, NomFichierActif
Else                'compteur NbFichier meme date
Dico2.Item(FDate) = Dico2.Item(FDate) + 1                'rang cle en cours
point = Application.Match(FDate, Dico1.keys, 0)                'ajout fichiers meme date
Dico1.Item(FDate) = Dico1.Item(FDate) & "-" & NomFichierActif
End If
End If
NomFichierActif = Dir
Loop    'boucle sur Dico2 pour concatenation fichiers meme date
For Each curKey In Dico2
If Dico2.Item(curKey) > 1 Then      'test si plusieurs fichiers meme date
'mise en tableau des noms de fichier
TFichier = Split(Dico1.Item(curKey), "-")
'nom de fichier final
FFichier = Left(TFichier(0), 14) & "*.txt"            'Chaine de commande DOS pour concatenation fichier
sConcat = "cmd /c Copy " & repertoire            'boucle fichier -1
point = UBound(TFichier)
For point = 0 To point - 1                'ajout fichier
sConcat = sConcat & TFichier(point) & "+" & repertoire
Next            'aout dernier fichier
sConcat = sConcat & TFichier(point)            'ajout nom de fichier final
sConcat = sConcat & " " & repertoire & FFichier            'commande shell
retval = Shell(sConcat, vbMinimizedNoFocus)            'attente: ici 200ms, peut etre remplace par ctrl process shell (a voir)
Sleep 200
End If
Next curKey
Application.ScreenUpdating = True
End Sub
      0

Discussions similaires

Ouvrir un fichier .pub sans Publisher
baissaoui -
baissaoui -

0 réponse