XL 2016 Ouverture d'un fichier .txt (avec partie variable) puis enregistrement sous .csv avec nom défini

[Karim48]

Bonjour,

Je souhaite extraire les données d'un fichier en .txt pour les enregistrer en .csv mais je bloque sur le code.

Actuellement mon code est le suivant:

<Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Workbooks("Macro VBA SAE.xlsm").Worksheets("SAE").Cells.ClearContents
Workbooks.Open Filename:="C:\Users\FR32835\Desktop\Doc SAP Tartampion\Interfaçage\SAE\extract_CES_SAE_v3_p0606876ugfe_20210611151946.txt"
Workbooks("extract_CES_SAE_v3_p0606876ugfe_20210611151946.txt").SaveAs ("C:\Users\FR32835\Desktop\Doc SAE Tartampion\Interfaçage\SAE\extract_CES_SAE_v3_p0606876ugfe_" & Format(Now(), "yyyymmdd") & ".xlsx")
Workbooks("extract_CES_SAE_v3_p0606876ugfe_" & Format(Now(), "yyyymmdd") & ".xlsx").Worksheets("extract_CES_SAE_v3_p0606876ugfe").rows("1:1").Select
Selection.Delete shift:=xlUp
Workbooks("extract_CES_SAE_v3_p0606876ugfe_" & Format(Now(), "yyyymmdd") & ".xlsx").Worksheets("extract_CES_SAE_v3_p0606876ugfe").Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1))
Workbooks("extract_CES_SAE_v3_p0606876ugfe_" & Format(Now(), "yyyymmdd") & ".xlsx").Worksheets("extract_CES_SAE_v3_p0606876ugfe").Cells.Copy _
Workbooks("Macro VBA SAE.xlsm").Worksheets("SAE").Range("A1")
Workbooks("extract_CES_SAE_v3_p0606876ugfe_" & Format(Now(), "yyyymmdd") & ".xlsx").Close False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub>

A noter que le fichier txt commence systématiquement par "extract_CES_SAE_v3_p0606876ugfe_" et que je souhaite l'enregistrer sous "extract_CES_SAE_v3_p0606876ugfe_" & Format(Now(), "yyyymmdd") & ".xlsx"

Merci d'avance pour votre aide

Cordialement

 

[job75]

Bonjour Karim48,

Je n'ai pas essayé de décortiquer votre code car il n'est pas clair.

En effet pour créer un fichier CSV à partir d'un fichier TXT c'est très simple :

Sub TXT_vers_CSV()
Dim fichierSource$, fichierDestination$, x%, texte$, a$(), n&
fichierSource = ThisWorkbook.Path & "\FichierTXT.txt" 'à adapter
fichierDestination = ThisWorkbook.Path & "\FichierCSV.csv" 'à adapter
x = FreeFile
Open fichierSource For Input As #x 'accès en lecture séquentielle
Do While Not EOF(1) 'EndOfFile : fin du fichier
    Line Input #x, texte 'récupère la ligne
    ReDim Preserve a(n) 'tableau VBA, base 0
    a(n) = Replace(texte, vbTab, ";") 'stocke le texte modifié dans le tableau a
    n = n + 1
Loop
Close #x 'fermeture du fichier
Open fichierDestination For Output As #x 'accès en écriture séquentielle
Print #x, Join(a, vbLf) 'concaténation
Close #x 'fermeture du fichier
MsgBox "Le fichier CSV a été créé..."
End Sub

Téléchargez les fichiers joints dans le même dossier (le bureau) et cliquez sur le bouton.

A+

 

[patricktoulon]

bonjour à tous
@job75
question 1:
si tu a peur d’être juste en mémoire et de ce fait ouvrir ton fichier en lecture séquentielle
pourquoi compile tu dans un array ?
si tu es trop juste tu le sera pendant la compilation dans l'array forcement
question 2:
pourquoi alors ne pas réécrire le new fichier avec append au lieu de compiler dans un array

 

[job75]

Bonjour patricktoulon,

Pourquoi parler de mémoire ? Lecture et écriture séquentielles sont très rapides c'est tout.

Quant à Append cela ajouterait des données au fichier, ce n'est pas le but.

A+

 

[patricktoulon]

re
la lecture complète l'est encore plus alors

Sub TXT_vers_CSV()
    Dim fichierSource$, fichierDestination$, x%, texte$, a$(), n&
    fichierSource = ThisWorkbook.Path & "\FichierTXT.txt"    'à adapter
    fichierDestination = ThisWorkbook.Path & "\FichierCSV.csv"    'à adapter

    x = FreeFile
    Open fichierSource For Input As #x: Lines = Input$(LOF(x), #x): Close #x

    x = FreeFile
    Open fichierDestination For Output As #x: Print #x, Replace(Lines, vbTab, ";"): Close #x

    MsgBox "Le fichier CSV a été créé..."
End Sub

 

[job75]

Input$(LOF(x), #x) m'est inconnu mais je ne demande qu'à apprendre.

Je ne vois pas de Append, pourquoi en parlais-tu ?

 

[patricktoulon]

je ne l'ai pas fait car tu m'a dis que c'etait pas un soucis de moire
textecomplet2=replace(textcomplet1,vbtab,";") c'est tout
mais si tu veux
lecture et ecriture sequentielle sans l'array

cette méthode est utilisé sur des lourd fichiers

Sub TXT_vers_CSV()
    Dim fichierSource$, fichierDestination$, x&, x2&, texte$, a$(), n&
    fichierSource = ThisWorkbook.Path & "\FichierTXT.txt"    'à adapter
    fichierDestination = ThisWorkbook.Path & "\FichierCSV.csv"    'à adapter
    x = FreeFile 'on prend un index libre de fichier
    Open fichierSource For Input As #x    'on ouvre
    x2 = FreeFile'on reprend un autre index  libre de fichier
    Open fichierDestination For Append As #x2' on ouvre aussi
    Do While Not EOF(X)    'EndOfFile : fin du fichier'on boulcle jusqu 'a la fin du fichier
        Line Input #x, texte    'récupère la ligne
        Print #x2, Replace(texte, vbTab, ";")'on ecrit simultanement le replace de la la ligne
    Loop
   'fermeture des fichier
   Close #x 
   Close #x2
    MsgBox "Le fichier CSV a été créé..."
End Sub

 

[patricktoulon]

Input$(LOF(x), #x) m'est inconnu mais je ne demande qu'à apprendre.

Je ne vois pas de Append, pourquoi en parlais-tu ?

re
je pourrais pas mieux l'expliquer

https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/lof-function

 

[patricktoulon]

si je devais traduire
Open fichierSource For Input As #x: Lines = Input$(LOF(x), #x): Close #x

Open fichierSource For Input As fichierX: Lines = Input$(TOUT, du fichierX): Close fichierX

attention!!! avec freefile
quand on prend un index il faut ouvrir le fichier avant de prendre le 2d

 

[patricktoulon]

re
pour FSO.OpenTextFile (par exemple )
lof(x) correspond a ".readall"
EOF(x) correspond a .AtEndOfStream

 

[ChTi160]

Bonsoir ,
merci
jean marie

 

[job75]

Bon j'ai testé les 2 macros suivantes sur un fichier TXT de 3 colonnes et 1 000 000 lignes (23,5 Mo).

Sub CSV_en_sequentiel() 'job75
Dim t, fichierSource$, fichierDestination$, x%, texte$, a$(), n&
t = Timer
fichierSource = ThisWorkbook.Path & "\FichierTXT.txt" 'à adapter
fichierDestination = ThisWorkbook.Path & "\FichierCSV.csv" 'à adapter
x = FreeFile
Open fichierSource For Input As #x 'accès en lecture séquentielle
Do While Not EOF(1) 'EndOfFile : fin du fichier
    Line Input #x, texte 'récupère la ligne
    ReDim Preserve a(n) 'tableau VBA, base 0
    a(n) = Replace(texte, vbTab, ";") 'stocke le texte modifié dans le tableau a
    n = n + 1
Loop
Close #x 'fermeture du fichier
Open fichierDestination For Output As #x 'accès en écriture séquentielle
Print #x, Join(a, vbLf) 'concaténation
Close #x 'fermeture du fichier
MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub

Sub CSV_en_bloc() 'patricktoulon
    Dim t, fichierSource$, fichierDestination$, x%, Lines$
    t = Timer
    fichierSource = ThisWorkbook.Path & "\FichierTXT.txt"    'à adapter
    fichierDestination = ThisWorkbook.Path & "\FichierCSV.csv"    'à adapter

    x = FreeFile
    Open fichierSource For Input As #x: Lines = Input$(LOF(x), #x): Close #x

    x = FreeFile
    Open fichierDestination For Output As #x: Print #x, Replace(Lines, vbTab, ";"): Close #x

    MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub

La 1ère macro (la mienne) s'exécute chez moi en 3,4 secondes.

La 2ème macro (celle de Patrick) s'exécute en 8,6 secondes donc 2,5 fois moins rapide.

 

[patricktoulon]

et la 3 eme (sequentielle append) tu l'a testé ?

 

[patricktoulon]

re
bon ben je l'ai testé et elle est plus rapide de 2 secondes chez moi
la tienne 6.xx
la mienne 4.xx

SEQUENTIELLE EN APPEND

Sub TXT_vers_CSV()
    Dim fichierSource$, fichierDestination$, x%, x2%, texte$, a$(), n&
    fichierSource = ThisWorkbook.Path & "\FichierTXT.txt"    'à adapter
    fichierDestination = ThisWorkbook.Path & "\FichierCSV.csv"    'à adapter
    x = FreeFile
    Open fichierSource For Input As #x    'accès en lecture séquentielle
    x2 = FreeFile
    Open fichierDestination For Append As #x2
   t = Timer
 Do While Not EOF(x)    'EndOfFile : fin du fichier
        Line Input #x, texte    'récupère la ligne
        Print #x2, Replace(texte, vbTab, ";")
    Loop
    Close #x, x2    'fermeture des fichier

   MsgBox "Durée " & Format(Timer - t, "0.00 \sec")

End Sub

la tienne

La MIENNE

ça confirme bien ce que je disais en cas de gros fichier la lecture doit se faire en séquentielle mais on peut largement se passer de l'array

par contre pour un fichier moins lourd c'est celle en un bloc qui va prendre le dessus
voila pourquoi je parlais de mémoire

 

[patricktoulon]

re
maintenant si tu veux plus rapide il y a l'object adobdstream aussi