IMPORTATION DE CHAMPS AS400 DANS UNE BASE DE DONNÉES MYSQL AVEC LE PILOTE ODBC CLIENT ACCESS

Private Sub Form_Load()

'Déclarations
Dim Connexion_AS400 As ADODB.Connection
Dim Recordset_AS400 As ADODB.Recordset
Dim Connexion_MYSQL As New ADODB.Connection
Dim Recordset_MYSQL As New ADODB.Recordset
Dim Code°Client As String
Dim Nom°Client As String
Dim i As Integer


Dim Adr_IP As String
Dim Nom_Base As String
Dim Login_Admin As String
Dim Password_Admin As String
Dim option_db As Integer

Adr_IP = "127.0.0.1"
Nom_Base = "nom base"
Login_Admin = "LoginAdmin"
Password_Admin = "PasswordAdmin"
option_db = 35


'Connexion à l'AS400
Set Connexion_AS400 = CreateObject("adodb.connection")
Connexion_AS400.Open "provider=IBMDA400;data source=NomServeurAS400", "MonLoginAS400", "MonPasswordAS400"

'Connexion à MYSQL
Set Connexion_MYSQL = CreateObject("adodb.connection")
Connexion_MYSQL.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & Adr_IP & ";DATABASE=" & Nom_Base & ";USER=" & Login_Admin & ";PASSWORD=" & Password_Admin & ";OPTION=" & option_db

Set Recordset_AS400 = CreateObject("ADODB.recordset")
Recordset_AS400.ActiveConnection = Connexion_AS400

Set Recordset_MYSQL = CreateObject("ADODB.recordset")
Recordset_MYSQL.ActiveConnection = Connexion_MYSQL

'Vide la table "Clients" de MySQL
Recordset_MYSQL.Open "TRUNCATE TABLE Clients"

Requête_SQL1 = " " & _
" select NTCLIE,NTNOMC " & _
" from AQFICHII.CLIENT "

Recordset_AS400.Open Requête_SQL1
Do Until Recordset_AS400.EOF
i = 1
For Each Fld In Recordset_AS400.Fields
Select Case i
Case 1
Code°Client = Fld.Value
Case 2
Nom°Client = Fld.Value
Case Else
End Select
i = i + 1
Next Fld

'Insertion des enregistrements dans la table Clients de MySQL
If Recordset_MYSQL.State = 0 Then
Recordset_MYSQL.Open "clients", Connexion_MYSQL, adOpenKeyset, adLockOptimistic
End If

With Recordset_MYSQL
.AddNew Array("Code_Client", "Nom_Client"), _
Array(Code°Client, Nom°Client)
.Update
End With

Recordset_AS400.MoveNext
Loop
Recordset_AS400.Close
Set Recordset_AS400 = Nothing
Recordset_MYSQL.Close
Set Recordset_MYSQL = Nothing

End Sub