Remplir une table dans un fichier distant

**zooffy** · 19/09/2017, 15h14

Bonjour à tous

Je suis un peu perdu pour remplir mes tables avec des fihciehrs CSV. Elles sont dans un fichier ACCESS mais je déclenche l'opération dans du code VBA dans un autre fichier.

Actuellement je fais cela :

Code :

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

1
2
DataDb.Execute ("DELETE FROM MaTable")
    DoCmd.TransferText acImportDelim, , "MaTable", "\\mon.server\GroupShares\FICHIER.csv", True

Sauf que je suis obligé d'avoir un link sur MaTable dans mon fichier ACCESS, sinon, il me crée une table en local.
Vu que j'ai créé une DataBase avec DataDb, comment je fais pour remplir la table avec cette DataBase.

Désolé si ça vous parait basique, mais j'ai pas trouvé comment faire.

Merci pour votre aide.

Bonne journée.

**tee_grandbois** · 19/09/2017, 17h19

Sauf que je suis obligé d'avoir un link sur MaTable dans mon fichier ACCESS

Oui, et le hic est que c'est le minimum requis avec la commande TransferText : la table doit être présente dans la base courante.
Une solution si tu ne veux pas linker ta table est de transférer le fichier texte dans une table locale, ensuite de copier les données de la table locale vers la table distante par requête SQL qui gère les bases distantes et enfin supprimer la table locale.
C'est (un peu) lourd mais c'est le seul moyen :

Code :

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

1
2
3
4
5
6
    dim currDb as database
   set currDb = currentdb()
   dataDb.Execute ("delete * from MaTable")
   DoCmd.TransferText acImportDelim, , "MaTable_tmp", "\\mon.server\GroupShares\FICHIER.csv", True
   currDb.Execute ("INSERT INTO MaTable IN '\\mon.server\MaBaseDistante.accdb' SELECT MaTable_tmp.* FROM MaTable_tmp;")
   currDb.Execute ("delete * from MaTable_tmp;")

**zooffy** · 20/09/2017, 09h20

ok, merci beaucoup pour ton aide.

Bon, je vais être très ennuyé pour mettre en place ta solution. Mais s'il n'y en a aps d'autre, je vais m'en contenter.
Mon souci est le suivant et je me rend compte que j'ai oublié ce "detail" dans l'énnoncé du problème : toutes les tables à mettre à jour en sont pas TOUTES présentes dans mes fichiers distants, du coup, si je fais des table locales que je pourrais supprimer juste après pour faire propre, comment je fais la différence entre celle qui sont linkées et les autres ?

Du coup, je vais continuer de linker toutes mes tables dans chaque fichier distant pour être pénard. Je pense que la gymnastique va trop complexe à mettre en place et puis la brutalité n'est pas toujours mauvaise......

En tout cas un grand merci pour ton aide.

**zooffy** · 20/09/2017, 12h30

J'ai eu une autre idée.

J'ai farfouillé un peu et j'ai trouvé un truc qui me semble pas mal que je vais tenter de transformer en procédure pour l'appeler avec des paramètres simples, genre le nom de la table et le nom du fichier.
Voici le lien du tuto que j'ai trouvé : https://excel.developpez.com/faq/?page=Access
Et voici le code que j'ai copié collé à un détail prêt que je décris plus bas :

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
 
    Dim AccessCn As ADODB.Connection
    Dim AccessRst As ADODB.Recordset
    Dim Csv_CN As New ADODB.Connection
    Dim Csv_Rst As New ADODB.Recordset
    Dim DossierCSV As String, NomTable As String
    Dim FichCSV As String, MaBase As String
    Dim nbEnr As Long
 
    'Répertoire du fichier CSV
    DossierCSV = "\\mon.server\groupshares\MonRepertoire"
    'Nom du fichier CSV à transfèrer
    FichCSV = "ROBOTS_TRUC.csv"
    'Chemin et nom de la base Access
    MaBase = "\\mon.server\UserData\Documents\MaDataBase.accdb"
    'Nom de la nouvelle Table Access
    NomTable = "MaTable"
 
    'Connection au fichier CSV
    Csv_CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DossierCSV & ";Extended Properties='text;FMT=Delimited'"
    'Requète dans le fichier CSV
    Csv_Rst.Open "SELECT * FROM " & FichCSV, Csv_CN, adOpenStatic, adLockOptimistic
 
    'Connection à la base de données Access
    Set AccessCn = New ADODB.Connection
    AccessCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & MaBase & ";"
 
    Csv_CN.Execute "SELECT * INTO [" & NomTable & "] IN '" & MaBase & "' From [" & FichCSV & "]", nbEnr
 
    AccessCn.Close
    Csv_Rst.Close
    Csv_CN.Close
    Set AccessRst = Nothing
    Set AccessCn = Nothing
    Set Csv_Rst = Nothing
    Set Csv_CN = Nothing

J'ai modifié cete ligne là : AccessCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & MaBase & ";"
Car au depart il me faisait un plantage en me disant que le format de la database n'est pas reconnu. Mais avec cette chaine là, j'ai le même message, sachant qu'il plante sur la ligne d'après.
Alors est ce que j'ai un souci avec la définition du provider ou est ce que j'ai un souci avec mon fichier de DataBase ?

Merci pour ton aide.

Invité · 20/09/2017, 13h03

Bonjour,
tu me diras si je me fourvoie, mais voila ce que j'ai compris!

tu as des fichiers CSV sur un répertoire distant. tu veux insérer dans une base Access, distante également, leurs contenu dans les table de même non si existe!

Code Classe ADODBRD :

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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
Private Connexion
Public TYPEBASE As MyAdo
Public Base
Public Server
Public Fichier
Public User
Public PassWord
Public Enum MyAdo
    ACCESS97 = 1
    ACCESS2000 = 2
    ACCESS2012 = 3
    ODBC = 4
    ORACLE = 5
    SQLSERVER2005 = 6
    SQLServer2008R2 = 7
    SQLite = 8
    SQLite3 = 9
    CSV = 10
    Excel = 11
    MySQL = 12
End Enum
Public Enum CommAdo
    adCmdFile = 256
    adCmdStoredProc = 4
    adCmdTable = 2
    adCmdTableDirect = 521
    adCmdText = 1
    adCmdU
    nknown = 8
End Enum
Public AvecTitre As Boolean
Public Enum AdodbTypeChamps
   adEmpty = 0
    adSmallInt = 2
    adInteger = 3
    adSingle = 4
    adDouble = 5
    adCurrency = 6
    adDate = 7
    adBSTR = 8
    adIDispatch = 9
    adError = 10
    adBoolean = 11
    adVariant = 12
    adIUnknown = 13
    adDecimal = 14
    adTinyInt = 16
    adUnsignedTinyInt = 17
    adUnsignedSmallInt = 18
    adUnsignedInt = 19
    adBigInt = 20
    adUnsignedBigInt = 21
    adFileTime = 64
    adGUID = 72
    adBinary = 128
    adChar = 129
    adWChar = 130
    adNumeric = 131
    adUserDefined = 132
    adDBDate = 133
    adDBTime = 134
    adDBTimeStamp = 135
    adChapter = 136
    adPropVariant = 138
    adVarNumeric = 139
    adVarChar = 200
    adLongVarChar = 201
    adVarWChar = 202
    adLongVarWChar = 203
    adVarBinary = 204
    adLongVarBinary = 205
End Enum
Public Enum ParameterDirection
    adParamUnknown = 0
    adParamInput = 1
    adParamOutput = 2
    adParamInputOutput = 3
    adParamReturnValue = 4
End Enum
Private Const txt = "[F.CSV]" & vbCrLf & "Format=Delimited(;)"
Public Property Let ShemaIn(Value As String)
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Server & "\schema.ini", 2, True)
NewFichier.Write Replace(txt, "F.CSV", Replace(Value, "#", "."))
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Property
 
 
Public Property Get PremiereTableAdo() As String
With Connexion.OpenSchema(20)
    If Not .EOF Then
        PremiereTableAdo = .Fields("TABLE_NAME")
    End If
    .Close
End With
End Property
Public Property Get TableExiste(TableName As String) As Boolean
With Connexion.OpenSchema(20)
    If Not .EOF Then
      .Filter = "TABLE_NAME ='" & TableName & "'"
       TableExiste = Not .EOF
    End If
    .Close
End With
End Property
Public Property Get TableToutes()
TableToutes = False
With Connexion.OpenSchema(20)
    If Not .EOF Then
      TableToutes = .getrows
 
 
    End If
    .Close
End With
End Property
 
Public Function Param(Champs As String, AdType As AdodbTypeChamps, Direction As ParameterDirection, size As Integer, Value As Variant) As Object
Set Param = CreateObject("ADODB.Command").CreateParameter(Champs, AdType, Direction, size, Value)
End Function
 
 
Public Function CommadExecute(adCm As CommAdo, Parameters As Variant, Sql As String) As Object
Dim I As Integer
  With CreateObject("ADODB.Command")
    .ActiveConnection = Connexion
    .CommandType = adCm
    .CommandTimeout = 500
    For I = 0 To UBound(Parameters)
        .Parameters.Append Parameters(I)
    Next
    .CommandText = Sql
    Set CommadExecute = .Execute
  End With
End Function
 
 
Private Function GenereCSTRING()
'Permet de générer le Cornec String
'1 - ACCESS 97
'2 - ACCESS 2000
'3 - ACCESS 2012
'4 - ODBC
'5 - ORACLE
'6 - SQL SERVER 2005
'7 - SQL Server 2008 R2
'8 - SQLite
'9 - SQLite3
If Trim("" & Fichier) = "" Then Fichier = Base
Select Case TYPEBASE
    Case Excel
            GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Base & ";Extended Properties=""Excel 12.0;HDR=" & Array("No", "YES")(Abs(AvecTitre)) & ";"""
    Case ACCESS97
        GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & Fichier
    Case ACCESS2000
        GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Persist Security Info=False"
    Case ACCESS2012
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
    Case MySQL
    GenereCSTRING = " DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & Server & ";UID=" & User & ";DATABASE=" & Base & ";Password=" & PassWord
    Case ODBC
        GenereCSTRING = "Provider=MSDASQL.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & Base
    Case ORACLE
        GenereCSTRING = "Provider=OraOLEDB.Oracle.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & Base
    Case SQLSERVER2005
        GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & Base & ";Data Source=" & Server
    Case SQLServer2008R2
        GenereCSTRING = "Provider=SQLNCLI;Server=" & Server & ";Database=" & Base & ";UID=" & User & ";PWD=" & PassWord & ";"
    Case SQLite
        GenereCSTRING = "Provider=OleSQLite.SQLiteSource.3; Data Source=" & Fichier
        GenereCSTRING = "Driver={SQLite ODBC (UTF-8) Driver};Database=" & Fichier & ";StepAPI=;Timeout="
    Case SQLite3
        GenereCSTRING = "Driver={SQLite3 ODBC Driver};Database=" & Fichier & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
    Case CSV
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Server & ";Extended Properties=""Text;HDR=" & Array("No", "YES")(Abs(AvecTitre)) & ";FMT=Delimited;"""
    Case Else
        GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
End Select
End Function
 
Public Function OpenSchema()
If Connexion.State = False Then
    OpenConnetion
End If
Set OpenSchema = Connexion.OpenSchema(20)
End Function
Public Function OpenConnetion()
    OpenConnetion = False 'Ouvre une connexion à  la base de données.
    On Error Resume Next
    Dim ConnecString
     Dim NbErr
    Set Connexion = CreateObject("ADODB.Connection")
    Connexion.Open GenereCSTRING 'ConnecString
    If Err = 0 Then
        OpenConnetion = True
       Connexion.CommandTimeout = 14400
    End If
    Debug.Print Err.Description
    Err.Clear
    On Error GoTo 0
End Function
Public Function CloseConnection()
CloseConnection = False
On Error Resume Next
    Connexion.Close 'Referme la connexion
    Set Connexion = Nothing
     If Err = 0 Then
        CloseConnection = True
    End If
    Err.Clear
    On Error GoTo 0
End Function
Public Function OpenRecordset(Sql)
'Retourne un RecordeSet
On Error Resume Next
    Dim Rs
Dim NbErr
Err.Clear
If Connexion.State = 0 Then
    OpenConnetion
End If
    Set OpenRecordset = CreateObject("ADODB.Recordset")
    OpenRecordset.Open Sql, Connexion, 1, 3
    If Err Then
    MsgBox Err.Description
       Set OpenRecordset = Nothing
    End If
    Err.Clear
End Function
Public Function RetournConnection()
Set RetournConnection = Connexion
End Function
Public Function CloseRecordSet(Rs)
On Error Resume Next
    Rs.Close
    Set CloseRecordSet = Nothing
End Function
Public Function Execute(Sql)
    Execute = False
    On Error Resume Next
    Dim NbErr
Reprise:
If Connexion.State = 0 Then
    OpenConnetion
End If
Debug.Print Sql
    Connexion.Execute Sql
    If Err = 0 Then
        Execute = True
Else
    MsgBox Err.Description
    End If
Err.Clear
End Function

Code Module1 :

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
Sub test()
Dim CnCsv As New ADODBRD, CnAccess As New ADODBRD
CnCsv.TYPEBASE = CSV: CnCsv.AvecTitre = True: CnCsv.Server = "C:\MyRepertoire\Nouveau dossier": CnCsv.OpenConnetion
CnAccess.TYPEBASE = ACCESS2012: CnAccess.Base = "C:\Users\dysorthographie\Documents\Database1.accdb": CnAccess.OpenConnetion
 
 
Dim TableAccess: TableAccess = CnAccess.TableToutes
 
 
For I = 0 To UBound(TableAccess, 2)
    Debug.Print TableAccess(2, I), CnCsv.TableExiste(TableAccess(2, I) & "#CSV")
    If CnCsv.TableExiste(TableAccess(2, I) & "#CSV") Then
        CnCsv.ShemaIn = TableAccess(2, I) & ".CSV"
        Sql = "insert into [" & TableAccess(2, I) & "] IN '" & CnAccess.Base & "' select * from   [" & TableAccess(2, I) & "#CSV];"
       CnCsv.Execute Sql
    End If
Next
End Sub

**zooffy** · 20/09/2017, 14h15

Tout d'abords un grand merci pour ton aide, c'est assez énorme.

Ensuite tu as tout compris à un detail près : les tables n'ont pas le meme nom que les fichiers.
J'ai encore un peu de mal à comprendre où ce gère le nom de la table (je suis un peu lent à apprehender le code fait par un autre) mais avec un peu de neuronne, je vais finir par comprendre.

J'ai tout de meme un souci beaucoup plus bloquant : j'ai copié collé ton code, le module ADODBRD à part, et le Sub Test dans mon module, j'ai juste change le nom de la Sub.
Et lorsque je lance le tout par le click d'un bouton j'ai un message qui me dit :

Compile error

A module is not a valid type

Et là, j'avoue qu'on vient de dépasser mes connaissances en ACCESS. Je me doute que c'est un souci de typage d'objet, ou un truc du genre. Il est possible que j'ai oublié de faire une manip pour preparer la compilation. Il est aussi possible que dans la version 2010 de ACCESS ce genre de chose ne soit pas possible.

Encore un grand merci pour ton code.

Invité · 20/09/2017, 14h30

ADODBRD est un module de classe, une sorte de caisse à outils ou tu pioche ce que tu as besoins! tu n’auras pas à faire de modification dessus!

ajoutes dans ton projet un module de classe; donne lui le nom ADODBRD.

ensuite il n'y a que la sub test qui t'intéresse!

CnAccess.TableToutes envoi dans un tableau le schéma des tables! CnCsv.TableExiste(TableAccess(2, I) & "#CSV") te dis si la table du schéma Access existe dans le schéma de la base Csv qui se résume à son répertoire c:\RepCsv!

ces deux méthode sont implémenté dans le module de classe ADODBRD (Outils)!

il te faudra improviser dans sub test une méthode qui matche la table Access et Csv!

Remplir une table dans un fichier distant

VBA Access

Discussions similaires

Partager

Partager