Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

AS400 - CONNECTION ET LECTURE SANS LIEN ODBC


Information sur la source

Catégorie :VBA Niveau : Débutant Date de création : 27/11/2002 Date de mise à jour : 27/11/2002 09:23:44 Vu : 10 377

Note :
10 / 10 - par 1 personne
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (7)
Ajouter un commentaire et/ou une note

Description

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

  • 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
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 !
 

Commentaires et avis

signaler à un administrateur
Commentaire de Spylover le 27/11/2002 21:20:05

Bravo,

signaler à un administrateur
Commentaire de carnez le 28/11/2002 09:01:55

test
1
2
3
4
5
6

signaler à un administrateur
Commentaire de cristiandan le 28/11/2002 13:56:28

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

signaler à un administrateur
Commentaire de tiboudoum le 19/12/2002 18:53:30

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.

signaler à un administrateur
Commentaire de arovane le 19/12/2002 23:32:34

é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!

signaler à un administrateur
Commentaire de arovane le 19/12/2002 23:35:29

é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
....

signaler à un administrateur
Commentaire de psgthery le 25/01/2008 14:14:44

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 :-)

Ajouter un commentaire



Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Comparez les prix Nouvelle version

Photothèque Nouveau !



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,952 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.