AS400 - CONNECTION ET LECTURE SANS LIEN ODBC

Dim CnnAs400 As adoDb.Connection
Dim RsAs400 As adoDb.Recordset
Dim Cnndb As New adoDb.Connection
Dim Rsdb As New adoDb.Recordset
Dim Champ1, Champ2 As String
Dim Champ3, Champ4, Champ5, Champ6 As Variant
Dim i As Integer


Set CnnAs400 = CreateObject("ADODB.connection")
CnnAs400.Open "provider=IBMDA400;data source=nom_du_système", "", ""
        
Set Cnndb = CurrentProject.Connection
       
       
Set RsAs400 = CreateObject("ADODB.recordset")
RsAs400.ActiveConnection = CnnAs400


    strSql = " " & _
    " select nartmk,mvtsmk,dtmvmk,sum(qtemk) as qte,sum(pdsmk) as poids, sum(valemk) as valeur " & _
    " from nom_de_la_bib_as400.nom_du_fichier_as400 " & _
    " where (sensmk='E' and signmk='+')" & _
    " group by nartmk,mvtsmk,dtmvmk" & _
    " having ((mvtsmk = 'A01' " & _
    " Or mvtsmk = 'FAN' Or MVTSMK = 'FAS' " & _
    " Or MVTSMK = 'FC ' Or mvtsMK = 'FD ' " & _
    " Or MVTSMK = 'FIT' Or MVTSMK = 'FM ' " & _
    " or MVTSMK = 'FTR' Or MVTSMK = 'RA+' " & _
    " Or MVTSMK = 'RA-' Or MVTSMK = 'RF ') " & _
    "And (DTMVMK between " & date_début & " and " & date_limite & " ))" & _
    " union" & _
    " select nartmk,mvtsmk,dtmvmk,sum(qtemk) * (-1) as qte,sum(pdsmk) * (-1) as poids, sum(valemk) * (-1) as valeur " & _
    " from nom_de_la_bib_as400.nom_du_fichier_as400 " & _
    " where (sensmk='E' and signmk='-')" & _
    " group by nartmk,mvtsmk,dtmvmk " & _
    " having ((mvtsmk = 'A01' " & _
    " Or mvtsmk = 'FAN' Or MVTSMK = 'FAS' " & _
    " Or MVTSMK = 'FC ' Or mvtsMK = 'FD ' " & _
    " Or MVTSMK = 'FIT' Or MVTSMK = 'FM ' " & _
    " or MVTSMK = 'FTR' Or MVTSMK = 'RA+' " & _
    " Or MVTSMK = 'RA-' Or MVTSMK = 'RF ') " & _
    "And (DTMVMK between " & date_début & " and " & date_limite & " ))"

RsAs400.Open strSql

    Do Until RsAs400.EOF
                i = 1
            For Each Fld In RsAs400.Fields
                Select Case i
                   Case 1
                    Champ1 = Fld.Value
                   Case 2
                    Champ2 = Fld.Value
                   Case 3
                      Champ3 = Fld.Value
                    Case 4
                    Champ4 = Fld.Value
                   Case 5
                    Champ5 = Fld.Value
                   Case 6
                    Champ6 = Fld.Value
                   Case Else
                End Select
                i = i + 1
            Next Fld

      If Rsdb.State = 0 Then
            Rsdb.Open "tab_achats_année", Cnndb, adOpenKeyset, adLockOptimistic
        End If

      With Rsdb
                .AddNew Array("nartmk", "mvtsmk", "qté achat", "poids achat", "valeur achat", "dtmvmk"), _
                        Array(Champ1, Champ2, Champ4, Champ5, Champ6, Champ3)
                .Update
     End With
            
      RsAs400.MoveNext
    Loop
        RsAs400.Close
        Set RsAs400 = Nothing
        Rsdb.Close
        Set Rsdb = Nothing