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

Karim48

XLDnaute Nouveau
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
 

dysorthographie

XLDnaute Accro
Bonsoir,
VB:
Sub test()
CreerTexte ThisWorkbook.Path & "\toto.CSV", Replace(OuvrirFichier(ThisWorkbook.Path & "\toto.txt"), vbTab, ";")
End Sub
'retourne un fichier texte
Public Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = oFile.ReadAll
oFile.Close
End Function

'permet de créer un fichier texte
Private Sub CreerTexte(Fichier, TxtDefault As String)
Dim FSO, NewFichier
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFichier = FSO.OpenTextFile(Fichier, 2, True)
NewFichier.Write TxtDefault
NewFichier.Close
Set NewFichier = Nothing
Set FSO = Nothing
End Sub
 

Discussions similaires

Réponses
0
Affichages
867
Réponses
12
Affichages
848

Statistiques des forums

Discussions
314 708
Messages
2 112 090
Membres
111 416
dernier inscrit
philipperoy83