Bonjour à tous,

Je travaille en ce moment sur un module access qui a été développé par une autre personne. L'une des fonctions VBA permet d'importer les fichiers csv avec pour délimiteur de champ une virgule et pour délimiteur de texte des guillemets "".
Cette fonction marche bien, et permet d'importer des fichiers n'ayant pas forcément le même nombre de colonnes (contrairement aux spécifications d'importations enregistrées).

Mon problème est que maintenant, certains fichiers csv à importer ont pour délimiteur de champ une tabulation et aucun délimiteur de texte. Lorsque je remplace dans le code, plus rien ne marche.

Voici le code original, avec en vert les modifications que j'ai apportées.

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
ImportReq "fichier.csv", "table_fichier"

Function ImportReq(NomFichier As String, NomTab As String)

Dim TextLine As String
Dim f As Integer, i  As Integer, j As Integer, k As Integer, Pos As Integer, verif As Integer
Dim champ(255) As String
Dim tb As DAO.Recordset, tb2 As DAO.Recordset
Dim Idmodele As Integer
Dim ReqSQL1 As String, ReqSQL2 As String, ReqSQL3 As String

On Error GoTo Exit_Import

Open Path(Application.CurrentDb.Name) & NomFichier For Input As #1
'on place dans la variable TextLine la premiere ligne du fichier censée contenir le nom des champs
Line Input #1, TextLine
TextLine = TextLine & ","    TextLine = TextLine & chr(9)
i = 2
f = 0
k = 1
'on parcours la variable TextLine pour récuperer le nom des champs que l'on place dans champ(f)
'le cas présent est celui d'enregistrement séparé par des tabulations ( char(9) )
Do While i <= Len(TextLine)
   Pos = InStr(i, TextLine, ",")    Pos = InStr(i, TextLine, chr(9))
   If Pos <> 0 Then
   j = Pos
   f = f + 1
   champ(f) = Mid(TextLine, i, j - i)
   ' on verifie que le nom du champ n'est pas en doublon
    If f > 1 Then
      For verif = 1 To f - 1
         If champ(verif) = champ(f) Then
          k = k + 1
          champ(f) = champ(f) & "_" & k
         End If
      Next verif
    End If
   'Debug.Print f & ":" & champ(f)
   i = j + 1
   End If
Loop

Close #1

'On enregistre un modèle d'importation temporaire "Modele tmp"
'Ouverture de la table contenant les spécifications d'importation de la base
Set tb = CurrentDb().OpenRecordset("MSysIMEXSpecs", dbOpenTable)

If tb.BOF Then
    Idmodele = 1 'au cas où la table est vide
    Else
    tb.MoveLast
    Idmodele = tb![SpecID] + 1
End If
With tb
    .AddNew
    ![DecimalPoint] = "."
    ![TextDelim] = """"    ![TextDelim] = ""
    ![FileType] = 0
    ![FieldSeparator] = ","    ![FieldSeparator] = chr(9)
    ![SpecType] = 1
    ![StartRow] = 0
    ![SpecID] = Idmodele
    ![SpecName] = "Modele tmp" & Int(Rnd * 1000) ' suffixe aléatoire pour éviter les doublons d'index
    .Update                                      ' sur les tables systèmes
End With

'Ouverture de la table contenant le détail des spécifications d'importation de la base
Set tb2 = CurrentDb().OpenRecordset("MSysIMEXColumns", dbOpenTable)

For i = 1 To f 'on parcours chaque champ
With tb2
    .AddNew
    ![DataType] = 10
    ![FieldName] = champ(i)
    ![Start] = 1 + (i - 1) * 255
    ![Width] = 255
    ![SpecID] = Idmodele
    .Update
    .Bookmark = tb2.LastModified
End With
Next i

DoCmd.TransferText acImportDelim, tb![SpecName], NomTab, Path(Application.CurrentDb.Name) & NomFichier, True, ""

tb2.Close
tb.Close

ReqSQL1 = "DELETE MSysIMEXSpecs.* FROM MSysIMEXSpecs WHERE MSysIMEXSpecs.SpecID = " & Idmodele & _
" WITH OWNERACCESS OPTION;"

ReqSQL2 = "DELETE MSysIMEXColumns.* FROM MSysIMEXColumns WHERE MSysIMEXColumns.SpecID = " & Idmodele & _
" WITH OWNERACCESS OPTION;"

DoCmd.SetWarnings False
DoCmd.RunSQL ReqSQL1
DoCmd.RunSQL ReqSQL2
DoCmd.SetWarnings True

Exit Function

Exit_Import:
MsgBox Err.Description, vbCritical + vbOKOnly

ReqSQL1 = "DELETE MSysIMEXSpecs.* FROM MSysIMEXSpecs WHERE MSysIMEXSpecs.SpecID = " & Idmodele & _
" WITH OWNERACCESS OPTION;"

ReqSQL2 = "DELETE MSysIMEXColumns.* FROM MSysIMEXColumns WHERE MSysIMEXColumns.SpecID = " & Idmodele & _
" WITH OWNERACCESS OPTION;"

DoCmd.SetWarnings False
DoCmd.RunSQL ReqSQL1
DoCmd.RunSQL ReqSQL2
DoCmd.SetWarnings True


End Function

Avec la fonction originale, je récupère bien des tables avec toutes mes colonnes et des noms de champ valides, mais avec la version modifiée par mes "soins", je n'ai plus que 3 colonnes avec comme noms de champs "ÿþ","F2","F3".

Si quelqu'un a une idée du problème...