Importer fichier texte avec colonne en texte

**munity** · 26/03/2018, 20h52

coucou le phorum

je développe une macro afin de mettre en forme un fichier pour utilisation dans un outil de publipostage (Print Shop Mail)
j'ouvre un fichier, je fais mon traitement puis j'exporte le fichier au format texte afin de garder les éléments comme numéro de client, numéro de téléphone (avec le 0 devant), idem pour les codes postaux en texte
or dès que je réimporte le fichier avec ce code
tous mes éléments se transforme en nombre ce qui est problèmatique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Workbooks.OpenText Filename:=répTraitement & nomfichier, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
            :=xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True

pour information voici le code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 
Option Compare Text
Sub TRAITEMENT_OXYGEN()
    Dim Col As Long
    Dim répTraitement As String
    Dim i As Long, J As Long, Ligne As Long, Colonne As Long
    Dim Cel As Range, C
    Dim tabColonne, Cols
    Dim arrSelection
    Dim P As Range
 
'Récupération Nom Fichier Client
    FichierClient = ActiveWorkbook.Name
 
'Correction Entête Colonnes
    Col = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Range(Cells(1, 1), Cells(1, Col)).NumberFormat = "General"
 
'Choix des colonnes à traiter
    On Error Resume Next
        Set P = Application.InputBox("Sélectionnez les colonnes à normaliser :", Type:=8)
        On Error GoTo 0
        Application.DisplayAlerts = True
        If P Is Nothing Then
            MsgBox "Sélection annulée"
            Exit Sub
        End If
 
    arrSelection = P.Address(False, False)
    tabColonne = Split(arrSelection, ",")
 
 'Traitement des colonnes
    For i = 0 To UBound(tabColonne)
        C = GetColumnRange(tabColonne(i))
        Cols = Split(C, ";")
        For J = 0 To UBound(Cols)
            Colonne = CLng(Cols(J))
            Ligne = Cells(Rows.Count, Colonne).End(xlUp).Row
                For Each Cel In Range(Cells(2, Colonne), Cells(Ligne, Colonne))
                    Cel.Value = Application.WorksheetFunction.Trim(UCase(SupprimerAccents(Cel.Value)))
                    Cel.Value = Replace(Cel.Value, Chr(10), "")
                    Cel.Value = Replace(Cel.Value, Chr(9), "")
                    Cel.Value = Replace(Cel.Value, Chr(160), "")
                    With Application
                        Cel.Value = .Clean(Cel.Value)
                    End With
 
                Next Cel
        Next
    Next
 
    TRAITEMENT_CODE_POSTAUX
 
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
'Initialisation du nom de Fichier en Sortie
    répertoire = ActiveWorkbook.Path
    Fichier = Mid(ActiveWorkbook.Name, 1, InStrRev(ActiveWorkbook.Name, ".") - 1)
    nomuser = Environ("UserName")
    répTraitement = Mid(répertoire, 1, InStrRev(répertoire, "\") - 1) & "\"
    ExtractionNiv1 = InStr(1, répertoire, "MD")
    ExtractionNiv2 = Mid(répertoire, ExtractionNiv1, 6)
    nomfichier = "A_" & ExtractionNiv2 & "_" & Fichier & "_" & UCase(SupprimerAccents(Left(Environ("UserName"), 3)))
 
'Création du répertoire si absent
    Dim fso As FileSystemObject
    Dim fsoMonDossier As Folder
    Dim stMonChemin As String
 
    stMonChemin = répTraitement
 
    Set fso = New FileSystemObject
 
        If Not fso.FolderExists(stMonChemin) Then
          Set fsoMonDossier = fso.CreateFolder(stMonChemin)
        End If
 
    ActiveSheet.Columns.EntireColumn.AutoFit
    ActiveSheet.Copy
        ActiveWorkbook.SaveAs Filename:=répTraitement & nomfichier & ".txt", FileFormat:=xlText, CreateBackup:=False
 
        Columns("A:A").Select
        For C = 1 To 2
            Selection.Insert Shift:=xlToRight
        Next
        Range("A1") = "DOSSIER"
        Range("B1") = "SEQUENCE"
        nomfichier = ActiveWorkbook.Name
        Ligne = Cells(Rows.Count, 3).End(xlUp).Row
 
        For i = 1 To Ligne 'séquentiel
            For R& = 2 To Ligne 'dossier
                    Cells(R, 1) = nomfichier
                        EX = Extrait(Cells(R, 1).Value, "MD", " ", "_", 1)
                        If IsArray(EX) Then Cells(R, 1).Resize(, UBound(EX) + 1).Value = EX
                    Cells(R, 1) = EX
                    Cells(R, 2).NumberFormat = "@"
                   Cells(R, 2).Value = Format(i, "00000")
                i = i + 1
            Next R
        Next i
 
Choix_Multi_Pose.Show
 
    ActiveSheet.Columns.EntireColumn.AutoFit
    Application.GoTo Range("A1"), True
 
'Fermeture des fichiers
    ActiveWorkbook.Close SaveChanges:=True
    Workbooks(FichierClient).Close SaveChanges:=False
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    Workbooks.OpenText Filename:=répTraitement & nomfichier, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
            :=xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True
 
    nomfichier = Mid(nomfichier, 1, InStrRev(nomfichier, ".") - 1)
 
    ActiveWorkbook.SaveAs Filename:=répTraitement & nomfichier & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=True
 
End Sub

y a t'il une solution simple pour me permettre d'importer au format texte l'intégralité du fichier ?

merci pour votre aide

david

**munity** · 26/03/2018, 22h04

en utilisant l'enregistreur de macro
j'ai ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub Macro1()
'
' Macro1 Macro
'
 
'
    ChDir "C:\Users\toto\Desktop\usb\MD0555"
    Workbooks.OpenText Filename:= _
        "C:\Users\toto\Desktop\usb\MD0555\A_MD0555.txt" _
        , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
        :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
        False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array _
        (1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8 _
        , 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), _
        Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array( _
        21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), _
        Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), Array(32, 2), Array(33, 2), Array( _
        34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array(38, 2), Array(39, 2), Array(40, 2), _
        Array(41, 2), Array(42, 2), Array(43, 2), Array(44, 2), Array(45, 2), Array(46, 2), Array( _
        47, 2), Array(48, 2), Array(49, 2), Array(50, 2), Array(51, 2), Array(52, 2), Array(53, 2), _
        Array(54, 2), Array(55, 2), Array(56, 2), Array(57, 2), Array(58, 2), Array(59, 2), Array( _
        60, 2), Array(61, 2), Array(62, 2), Array(63, 2)), TrailingMinusNumbers:=True
End Sub

je sais que array correspond à la longueur et au type de données = 2 pour texte
le but serait de lui dire que toutes les colonnes sont de type texte quelque soit le nombre de colonne

une idée ou une voie à explorer ?

david

**Menhir** · 27/03/2018, 09h04

Regarde dans l'aide VBA de OpenText le paramètre FieldInfo pour passer les champs que tu veux protéger à xlTextFormat.
https://msdn.microsoft.com/fr-fr/vba...t-method-excel

**munity** · 27/03/2018, 09h55

merci à toi
j'ai donc modifié mon code comme suit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
   Workbooks.OpenText Filename:=répTraitement & nomfichier, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
        :=xlDoubleQuote, Tab:=True, fieldinfo:=xlTextFormat, local:=True

mais il semble planté à l'instruction fieldinfo:=xltextformat

une idée pour la syntaxe ?

pourtant il me semble avoir bien respecté la syntaxe de l'instruction

david

**Menhir** · 27/03/2018, 10h17

Envoyé par munity

mais il semble planté à l'instruction fieldinfo:=xltextformat
une idée pour la syntaxe ?

FieldInfo est une matrice (il faut indiquer la valeur de chaque colonne).
Regarde le code proposé par l'enregistreur de macro.

**munity** · 27/03/2018, 10h24

j'ai trouvé ceci sur un phorum pour avoir lors de l'importation un nombre de colonnes dynamique
je part du principe de tout garder en texte
voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
'Définition des colonnes et du type  
 dercol = Cells(1, Columns.Count).End(xlToLeft).Column
    Dim TabFieldInfo As Variant
        For x = 1 To dercol
            ReDim Preserve TabFieldInfo(x)
            TabFieldInfo(x) = Array(x, 2)
        Next x
 
'importation du fichier
   Workbooks.OpenText Filename:=répTraitement & nomfichier, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
        :=xlDoubleQuote, Tab:=True, fieldinfo:=TabFieldInfo, local:=True

mais il me met incompatibilité de type ?

je ne vois pas pourquoi

david

Importer fichier texte avec colonne en texte [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager