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 |
Partager