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
| Sub Import()
Dim rng As Range
Dim Cn As ADODB.Connection
Dim oCm As ADODB.Command
Dim IntData As Long
Dim StrData As String
Dim DateData As Date
Dim NameTablesBDD() As Variant
Dim NameField() As Variant
Dim NameFieldBDD() As Variant
IDBDD() As Variant
' Enregistrements des tables de la BDD auxquelles correspondent chaque champ du Spreadsheet
' Enregistrements du nom des champs de la BDD auxquelles correspondent chaque champ du Spreadsheet
Worksheets("BoundBDD").Activate
NbFields = Range(Cells(1, 2), Cells(1, 2).End(xlToRight)).Cells.Count
ReDim NameTablesBDD(NbFields)
ReDim NameField(NbFields)
ReDim NameFieldBDD(NbFields)
ReDim ColField(NbFields + 1)
For Col = 2 To NbFields + 1
NameTablesBDD(Col - 1) = Cells(2, Col)
NameField(Col - 1) = Cells(1, Col)
NameFieldBDD(Col - 1) = Cells(3, Col)
Next Col
'Liaison de la connexion avec le fichier Access
On Error GoTo ADO_ERROR
Set Cn = New ADODB.Connection
'Add adress path
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=XXX ;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open
'-------------------
Worksheets("OriginImport").Activate
'récupération du nombre d'éléments à importer
NbImport = Range(Cells(2, 2), Cells(2, 2).End(xlDown)).Cells.Count
ReDim IDBDD(NbImport)
'Pour chacun des champs utilisés dans la base de données
For FieldBDD = 1 To NbFields
'Récupération de la colonne dans la feuille "Origin Import" qui correspond au champ récupéré dans la feuille "BoundBDD"
Col = 0
Do
Col = Col + 1
Loop While Cells(1, Col) <> NameField(FieldBDD)
'Procédure d'importation si ce champ est un nombre
If IsNumeric(Cells(2, Col)) Then
For Row = 2 To NbImport + 1
IntData = Cells(Row, Col).Value
Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
'Si l'enregistrement est nouveau, on crée le nouvel enregistrement, puis on récupère l'id de cet enregistrement dans la base de données
If FieldBDD = 1 Then
oCm.CommandText = "INSERT INTO" & NameTablesBDD(FieldBDD) & "([" & NameFieldBDD(FieldBDD) & "]) VALUES" & "(" & IntData & ")"
oCm.CommandText = "$..=MYSQL_QUERY($toninsert)"
oCm.CommandText = "$UID=mysql_insert_id()"
'Si l'enregistrement est déjà créé, on le modifie simplement (en utilisant l'id récupéré lors du premier enregistrement)
Else
oCm.CommandText = "UPDATE" & NameTablesBDD(FieldBDD) & "SET" & NameFieldBDD(FieldBDD) & "=" & IntData & " WHERE id = " & UID
End If
oCm.Execute nLigneRecup
Next Row
'Procédure d'importation si ce champ est une date
ElseIf IsDate(Cells(2, Col)) Then
For Row = 2 To NbImport + 1
DateData = CDate(Cells(Row, Col).Value)
Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
'Si l'enregistrement est nouveau, on crée le nouvel enregistrement, puis on récupère l'id de cet enregistrement dans la base de données
If FieldBDD = 1 Then
oCm.CommandText = "INSERT INTO" & NameTablesBDD(FieldBDD) & "([" & NameFieldBDD(FieldBDD) & "]) VALUES" & "(#" & DateData & "#)"
oCm.CommandText = "$..=MYSQL_QUERY($toninsert)"
oCm.CommandText = "$UID=mysql_insert_id()"
'Si l'enregistrement est déjà créé, on le modifie simplement (en utilisant l'id récupéré lors du premier enregistrement)
Else
oCm.CommandText = "UPDATE" & NameTablesBDD(FieldBDD) & "SET" & NameFieldBDD(FieldBDD) & "=#" & DateData & "# WHERE id = " & UID
End If
oCm.Execute nLigneRecup
Next Row
' Procédure d'importation si ce champ est une variable texte
Else
For Row = 2 To NbImport + 1
StrData = Cells(Row, Col).Value
Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
'Si l'enregistrement est nouveau, on crée le nouvel enregistrement, puis on récupère l'id de cet enregistrement dans la base de données
If FieldBDD = 1 Then
oCm.CommandText = "INSERT INTO" & NameTablesBDD(FieldBDD) & "([" & NameFieldBDD(FieldBDD) & "]) VALUES" & "('" & StrData & "')"
oCm.CommandText = "$..=MYSQL_QUERY($toninsert)"
oCm.CommandText = "$UID=mysql_insert_id()"
'Si l'enregistrement est déjà créé, on le modifie simplement (en utilisant l'id récupéré lors du premier enregistrement)
Else
oCm.CommandText = "UPDATE" & NameTablesBDD(FieldBDD) & "SET" & NameFieldBDD(FieldBDD) & "=" ' & StrData & "' WHERE id = " & UID
End If
Next Row
End If
Next FieldBDD
'-------------------
If nLigneRecup = 0 Then
MsgBox "Pas de données à transférer"
End If
If Cn.State <> adStateClosed Then
Cn.Close
End If
Application.StatusBar = False
If Not oCm Is Nothing Then Set oCm = Nothing
If Not Cn Is Nothing Then Set Cn = Nothing
MsgBox "Transfert Terminé.", vbInformation
ADO_ERROR:
MsgBox Err.Description
End Sub |
