Bonjour,
mon but de faire une macro VBA réalisant la même action qu'un fichier AS400 .tto dont voici le source:
TRTOPC
 
FROM        LCFFIC/LCCCP001
SELECT      CLIENT,COMPTE,NOMCLI,SOLDEC,SIGNE,SOLDCV,HCCMRI
SELECT      ,PTFVAL
WHERE       (HCCJUR BETWEEN 1 AND 4) AND (DEBQ LIKE 'FRF_')
WHERE        OR (HCCJUR BETWEEN 49 AND 59) AND (DEBQ LIKE 'F
WHERE       RF_') OR (HCCJUR BETWEEN 116 AND 119) AND (DEBQ
WHERE        LIKE 'FRF_') OR (HCCJUR BETWEEN 1 AND 4) AND  
WHERE       (DEBQ LIKE 'EUR_') OR (HCCJUR BETWEEN 49 AND 59)
WHERE        AND (DEBQ LIKE 'EUR_') OR (HCCJUR BETWEEN 116
WHERE        AND 119) AND (DEBQ LIKE 'EUR_')
ORDER BY
3
U:\Secg\Eng\SAS_Echange\Autorisation\base.xls
;312
13211 661
F:\SECG\ENG\SAS_ECHANGE\AUTORISATION\BASE.FDF
22
JOIN BY
GROUP BY
HAVING
SYSTEM      ODIN
OPTIONS     2[[.HMSDMYN11
 
 
ig341
winspool
ig341
1
10
6
1
SQLSEL
HTML        000    2    2  1  1  1  10000000000100000000100001000003006160010
HCSET       windows-1252
HTITLE
HCTEXT
PROPS       000110
 

 
J'ai essayé de me connecté à l'as400 via ODBC avec le code suivant:
 
Dim cnx, s, rs
Set cnx = New ADODB.Connection
Set rs = New ADODB.Recordset
 
 
cnx.ConnectionTimeout = 30
cnx.Open "Provider=IBMDA400;Data Source=truc;uid=truc;pwd=truc"
 
Et quand j'execute la macro j'ai le message d'erreur suivant: une opération OLE DB en plusieurs étapes a généré des erreurs.
 
Quelqu'un a t-il déjà réalisé ce type de macro? Sinon avez-vous déjà écris un VBScript dans le meme genre?
 
Merci d'avance de m'aider.

Bon group sur l'AS400 avec ODBC
http://groups.google.com/groups?hl [...] l.database
 
Et
 
www.vbfrance.com =>
 
pas de configuration ODBC pour établir une connexion à une BD DB2400 (pas de DSN)
lecture d'un fichier dans une bibliothèque, sélection des enreg et champs, écriture dans une table du projet ACCESS2000 en cours  
 
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
 
 
http://beta.experts-exchange.com =>
I use this code to get a connection to the IBM AS400 ODBC Driver.  (The code is in context of creating a DTS Package using VBA)
 
'Create Connection to AS400
Set oConnection = oPackage.Connections.New("MSDASQL.1" )
With oConnection
 .Name = "AS400640 Connection"
 .DataSource = "AS400640 FOR WIMIS" 'This ODBC connections needs to be set up wherever this package is executed from
 .Description = "Description - AS400640 Connection"
 .Id = 1
 .UserID = strAS400_UserID
 .Password = strAS400_Password
 .ConnectionTimeout = 300
End With
oPackage.Connections.Add oConnection
Set oConnection = Nothing
 
What code would I use to connect to the IBM OLE DB Driver.  I can not get it working at all!  Thank you.