As400 - connection et lecture sans lien odbc

Soyez le premier à donner votre avis sur cette source.

Snippet vu 15 122 fois - Téléchargée 37 fois

Contenu du snippet

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

Source / Exemple :


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

Conclusion :


La syntaxe de la requête SQL n'est, ni ACCES, ni VB.
Elle s'approche, pour ceux qui connaissent, de celle de Show-Case, et , bien sûr, de SQL400

Mais il y a toujours des variantes : virgule au lieu de point-virgule,.... Et l'AS400 renvoie des erreurs du style 'Erreur inconnue", ce qui n'est guère parlant !

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
vendredi 1 décembre 2000
Statut
Membre
Dernière intervention
25 janvier 2008

Merci, mais j'aurai quelques questions :
CnnAs400.Open "provider=IBMDA400;data source=nom_du_système", "", ""
les 2 champs a remplir correspondent au compte et au mdp ?
Rsdb.Open "tab_achats_année", Cnndb, adOpenKeyset, adLockOptimistic
A quoi correspondent adOpenKeyset et adLockOptimistic
je vous remerci d'avance pour les réponses :-)
Messages postés
9
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
18 février 2003

énorme, tsé kté kan meme le seul en france a voir posté ca sur le net :) tu sors d'ou?

J'espere ke jvais reussir à convertir ca sous access 97
....
Messages postés
9
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
18 février 2003

énorme, tsé kté kan meme le seul en france a voir posté ca sur le net :) tu sors d'ou?

J'espere ke ca marche!
Messages postés
1
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
19 décembre 2002

Salut,
C'est pas mal du tout, mais il y a un pb concernant les données alphanumériques... (pour les décimales c'est top) Apparement le Recordset les retourne toutes à blanc !!!! Cela vient sans doute de l'EBCDIC. Si tu as une solution, ça m'intéresse vachement.
Merci d'avance.
Messages postés
52
Date d'inscription
lundi 26 novembre 2001
Statut
Membre
Dernière intervention
4 novembre 2005

Génial, ca faisait longtemps que je cherchais comment faire cette connexion sans utiliser la DSN système et à chaque fois ca me prenait un peu le choux. Je ne l'ai pas essayé mais si ca marche BRAVO. Je le garde en réserve pour mes prochains développements
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.