Boucle pour enregistrement fichiers sous format xlsx

Bonjour le forum

J'ai besoin de transformer 3 fichiers en "txt" vers du "xlsx"

j'arrive à l'aide du développeur à créer un code qui me permet d'ouvrir un fichier "txt" et de le ré-enregistrer en format "UTF8"

Le truc c'est que j'ai trois fichiers que j'importe vers un dossier, mais ils n'ont pas le même nom comment puis je faire pour boucler le code suivant?

Sub Préparation_Fichiers_exploitable_FTTH_xlsx()
'
' Macro2 Macro
'

'
    Workbooks.OpenText Filename:= _
        "C:\Users\jean-francois\Desktop\Nouveau dossier (2)\Appui FTTH.txt", Origin:= _
        65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, FieldInfo:=Array(1, 1), TrailingMinusNumbers _
        :=True
    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, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=True, FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
        , 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
        (14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
        Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _
        27, 1)), TrailingMinusNumbers:=True
    Range("D10").Select
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\jean-francois\Desktop\Nouveau dossier (2)\Appui FTTH.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub

Je fais suivre en pièces jointes les fichiers

J'applique le format UTF8 afin de récupérer les données avec les bons caractères comme les "é" ou "è"

D'avance merci pour votre aide et votre disponibilité

bonjour si ton code d'enregistrement fonctionne voici une proposition...

j'ai pas testé sur ma machine....

a+

fred

Sub convertir_fichiers()
Dim dossier, fich1, fich2, fich3 As String
 dossier = "C:\Users\jean-francois\Desktop\Nouveau dossier (2)\"
 fich1 = "Appui FTTH.txt"
 fich2 = "Chambre FTTH.txt"
 fich3 = "Appui ERDF.txt"

Préparation_Fichiers (dossier & fich1), (dossier & Replace(fich1, "txt", "xlsx"))
Préparation_Fichiers (dossier & fich2), (dossier & Replace(fich2, "txt", "xlsx"))
Préparation_Fichiers (dossier & fich2), (dossier & Replace(fich3, "txt", "xlsx"))

End Sub

Sub Préparation_Fichiers(Fsource As String, Fdest As String)
   Workbooks.OpenText Filename:= _
        Fsource, Origin:= _
        65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, FieldInfo:=Array(1, 1), TrailingMinusNumbers _
        :=True
    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, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=True, FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
        , 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
        (14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
        Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _
        27, 1)), TrailingMinusNumbers:=True
    Range("D10").Select
    ActiveWorkbook.SaveAs Filename:=Fdest, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub

c

Bonsoir le forum

Bonsoir le fil

Merci fred2406 je regarderai demain et je te tiendrai au courrant

Bonsoir le forum

Bonsoir le fil

Merci pour l'aide et surtout la solution fred2406 ça fonctionne impec

Bonsoir

Dans ce cas

Merci

fred

MERCI BEAUCOUP FRED

Bonjour le fil

Dans la commande j'ai trois fichiers, comment faire si je veux en renommer qu'un seul?

Bonjour

tu met en commentaire ceux que tu veux pas, en mettant une apostrophe en debut de ligne de code

exemple pour faire que le deuxième fichier :

Sub convertir_fichiers()
Dim dossier, fich1, fich2, fich3 As String
 dossier = "C:\Users\jean-francois\Desktop\Nouveau dossier (2)\"
 fich1 = "Appui FTTH.txt"
 fich2 = "Chambre FTTH.txt"
 fich3 = "Appui ERDF.txt"

'Préparation_Fichiers (dossier & fich1), (dossier & Replace(fich1, "txt", "xlsx"))
Préparation_Fichiers (dossier & fich2), (dossier & Replace(fich2, "txt", "xlsx"))
'Préparation_Fichiers (dossier & fich2), (dossier & Replace(fich3, "txt", "xlsx"))

End Sub

Bonjour fred 2406

oui je connais cette manip pour annuler une partie du code, mais je me suis mal exprimer

Quand je lance la macro, si il manque un fichier dans le dossier ça beugue.

Il y a des fois où je n'importe que un ou deux des ces trois fichiers et la je suis concé

dans ce cas il faut tester l'existence du fichier avant de faire l'import

Sub convertir_fichiers()
Dim dossier, fich1, fich2, fich3 As String
 dossier = "C:\Users\jean-francois\Desktop\Nouveau dossier (2)\"
 fich1 = "Appui FTTH.txt"
 fich2 = "Chambre FTTH.txt"
 fich3 = "Appui ERDF.txt"

if dir (dossier & fich1) <> "" then Préparation_Fichiers (dossier & fich1), (dossier & Replace(fich1, "txt", "xlsx"))
if dir (dossier & fich2) <> "" then Préparation_Fichiers (dossier & fich2), (dossier & Replace(fich2, "txt", "xlsx"))
if dir (dossier & fich3) <> "" then Préparation_Fichiers (dossier & fich2), (dossier & Replace(fich3, "txt", "xlsx"))

End Sub

la fonction DIR (chemin+ fichier) renvoi "" si le fichier n'existe pas

fred

là c'est impec

MERCI BEAUCOUP Fred2406