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

Karim48 · 14 Juin 2021

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 · 14 Juin 2021

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 :

VB:

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 · 14 Juin 2021

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 · 14 Juin 2021

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 · 14 Juin 2021

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

VB:

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 · 14 Juin 2021

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

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

patricktoulon · 14 Juin 2021

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

VB:

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 · 14 Juin 2021

job75 à dit:
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 · 14 Juin 2021

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 · 14 Juin 2021

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

ChTi160 · 14 Juin 2021

Bonsoir ,
merci
jean marie

job75 · 14 Juin 2021

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

VB:

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 · 14 Juin 2021

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

patricktoulon · 14 Juin 2021

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

VB:

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 · 14 Juin 2021

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

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

Karim48

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires