begin process at 2012 02 16 15:25:20
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBA

 > AS400 - CONNECTION ET LECTURE SANS LIEN ODBC

AS400 - CONNECTION ET LECTURE SANS LIEN ODBC


 Information sur la source

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

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

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

Auteur : carnez

Ecrire un message privé
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 !


 Sources de la même categorie

Source avec Zip Source avec une capture OUTLOOK ATTACHEMENT SAVER par MoiLafouine
Source avec Zip GESTION PERSONNEL par oudlarbi
Source avec Zip Source avec une capture CALENDRIER EN VBA POUR EXCEL 2010 par nounou94
Source avec Zip Source avec une capture MANIPULER LES FENETRES ENFANT D'EXCEL par bigfish_le vrai
Source avec Zip Source avec une capture COLLECTION ID par Le Pivert

Commentaires et avis

Commentaire de Spylover le 27/11/2002 21:20:05

Bravo,

Commentaire de carnez le 28/11/2002 09:01:55

test
1
2
3
4
5
6

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

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.

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!

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

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

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
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

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,484 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales