XL 2019 Guillemets crées en trop, csv vers xls

[msauvegrain]

Bonsoir,

Une petite macro en VB, sur une base développée par Job75, j'ai le problème suivant certains fichiers ne sont pas bien traités.
Des Guillemets sont ajoutés par deux ou trois dans le fichier de retour.
En exemple le fichier à traiter et les deux fichiers de retour.
Je ne vois pas où est le problème, et de plus ça marche avec d'autres fichiers sans problèmes

Merci de votre aide.

@+, Michel

Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, nom$, j, k, m, p, r, s
dossier1 = "CSV\" 'nom du sous-dossier, modifiable
dossier2 = "XLS\" 'nom du sous-dossier, modifiable
remplace = Array("é", "É", "Ã~¨", "â", "½") 'liste modifiablee
par = Array("é", "É", "è", "â", "½") 'liste modifiable
n = 0
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
    n = n + 1
    Workbooks.OpenText chemin & fichier, TextQualifier:=xlTextQualifierDoubleQuote, Comma:=True, DecimalSeparator:=".", Local:=True
    With ActiveWorkbook.Sheets(1)
        .Rows("1:6").Delete
        .Range("A1").Value = "Nom"
        .Range("B1").Value = "Pays"
        .Range("C1").Value = "Séries"
        .Range("D1").Value = "Nums"
        .Range("E1").Value = "Date d_émission"
        .Range("F1").Value = "Date d_expiration"
        .Range("G1").Value = "Largeur"
        .Range("H1").Value = "Height"
        .Range("I1").Value = "Papier"
        .Range("J1").Value = "Filigrane"
        .Range("K1").Value = "Émission"
        .Range("L1").Value = "Format"
        .Range("M1").Value = "Dentelure"
        .Range("N1").Value = "Impression"
        .Range("O1").Value = "Gomme"
        .Range("P1").Value = "Monnaie"
        .Range("Q1").Value = "FaceValue"
        .Range("R1").Value = "Tirage"
        .Range("S1").Value = "Variétés"
        .Range("T1").Value = "Pointage"
        .Range("U1").Value = "Pertinence"
        .Range("V1").Value = "Couleurs"
        .Range("W1").Value = "Thèmes"
        .Range("X1").Value = "Description"
        .Range("Y1").Value = "Lien"
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        .Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
        For i = 0 To UBound(par)
            .Cells.Replace remplace(i), par(i), xlPart
        Next i
        nom = Replace(fichier, "fr_stamps_csv_list_country_", "")
        nom = Replace(fichier, ".csv", "")
        j = InStr(nom, "-")
        nom = Mid(nom, j + 1)
        m = InStr(nom, "C38E")
        nom = IIf(m, (Replace(nom, "C38E", "I")), nom)
        m = InStr(nom, "C389")
        nom = IIf(m, (Replace(nom, "C389", "É")), nom)
        m = InStr(nom, "C3A9")
        nom = IIf(m, (Replace(nom, "C3A9", "é")), nom)
        m = InStr(nom, "C3AE")
        nom = IIf(m, (Replace(nom, "C3AE", "I")), nom)
        m = InStr(nom, "C3B4")
        nom = IIf(m, (Replace(nom, "C3B4", "o")), nom)
        m = InStr(nom, "C3A8")
        nom = IIf(m, (Replace(nom, "C3A8", "è")), nom)
        m = InStr(nom, "C3AF")
        nom = IIf(m, (Replace(nom, "C3AF", "ï")), nom)
        m = InStr(nom, "C3A7")
        nom = IIf(m, (Replace(nom, "C3A7", "ç")), nom)
        m = InStr(nom, "_C3A0_")
        nom = IIf(m, (Replace(nom, "C3AE", "_")), nom)
        m = InStr(nom, "C3A0")
        nom = IIf(m, (Replace(nom, "C3A0", "_")), nom)
        m = InStr(nom, "C3BC")
        nom = IIf(m, (Replace(nom, "C3BC", "ü")), nom)
        m = InStr(nom, "_-_")
        nom = IIf(m, (Replace(nom, "_-_", "_")), nom)
        m = InStr(nom, "-")
        nom = IIf(m, (Replace(nom, "-", "_")), nom)
        .SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
        nom = "X_" & nom
        .SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
    End With
    ActiveWorkbook.Close
    fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub

 

[msauvegrain]

RE Bonsoir,

Je vous joins une liste de fichiers pour tester. Elle est différente de la précédente.

Une question comment forcer la colonne FaceValue en mode texte lors de l'enregistrement en XLS ?

Et une dernière, comment créer un fichier XLS avec la liste des fichiers csv du répertoire CSV crée ?

Merci,

Si je ne suis pas clair, je me tiens à votre disposition pour tout renseignement.

@+, Michel

 

[Staple1600]

Bonsoir le fil

Et une dernière, comment créer un fichier XLS avec la liste des fichiers csv du répertoire CSV crée ?

Pour cette partie, de nombreux exemples dans les archives du forum.

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

 

[msauvegrain]

Bonsoir,
Jai résolu une partie de mon problème en modifiant la ligne :

Workbooks.OpenText chemin & fichier, Origin:=65001, DataType:=xlDelimited, ConsecutiveDelimiter:=False, TextQualifier:=xlDoubleQuote, Comma:=True, DecimalSeparator:=".", Local:=True

Elle force la reconnaissance de la source CSV en UTF-8(Origin) et la valeur de TextQualifier était érronée .

Maintenant, je veux forcer les colonnes E F et Q en format de cellule Texte et les colonnes G et H en réel simple.

Qqn a une idée ?

Je joins le fichier modifié,

Pour Staple 1600 je voudrais inclure le traitement des noms dans la procédure.

Merci de votre aide