Option Compare Database
Public Function Imp_CA()
‘ Variables de connexion ADO
Dim CnnAs400 As ADODB.Connection
Dim RsAs400 As ADODB.Recordset
Dim Cnndb As New ADODB.Connection
Dim Rsdb As New ADODB.Recordset
Dim strTabSupprimer As String
Dim strSQL As String
Dim i As Integer
Dim fld As ADODB.Field
' Variables paramètres
Dim Dat As String 'Variable Date de bon
Dim Nas As String 'Variable nom de l'As400
Dim Nus As String 'Variable nom utilisateur
Dim Cus As String 'Variable Code Utilisateur
' Attribue des valeurs aux variables
' Transforme le contrôle date du formulaire d'accueil par exemple 24/10/06 en texte de 6 caractères 061024
Dat = Right(Form_Frm_Accueil.[Txt_DateBon], 2) & Mid(Form_Frm_Accueil.[Txt_DateBon], 4, 2) & Left(Form_Frm_Accueil.[Txt_DateBon], 2)
' Les trois variables suivantes vont chercher leurs valeurs dans la table « Paramètres »
Nas = Nz(Dlookup("Nom_AS400", "Tbl_Parametres"))
Nus = Nz(Dlookup("Identifiant", "Tbl_Parametres"))
Cus = Nz(Dlookup("Mot_Passe", "Tbl_Parametres") )
' Nous supprimons les données de la table "Tbl_Import_Ca"
DoCmd.SetWarnings False
strTabSupprimer = "DELETE * FROM [Tbl_Import_Ca];"
DoCmd.RunSQL strTabSupprimer
DoCmd.SetWarnings True
' Nous lançons la connexion.
Set CnnAs400 = CreateObject("ADODB.connection")
CnnAs400.Open "provider=IBMDA400;data source=" & Nas & "", Nus, Cus
' Attention à l'orthographe, sinon galère
Set Cnndb = CurrentProject.Connection
Set RsAs400 = CreateObject("ADODB.recordset")
RsAs400.ActiveConnection = CnnAs400
'Nous créons la Requête.
strsql = " " & _
" SELECT T01.NOBON ,T01.COVEN ,T01.BONDA||T01.BONDM||T01.BONDJ ," &_
" T01.COCLI ,T01.MOBON ,T02.NOVEN " & _
" FROM GESTCOM.AVENTP1 T01 " & _
"JOIN GESTCOM.BVENDP1 T02 " & _
" On T01.COVEN = T02.COVEN " & _
" WHERE (T01.BONDA||T01.BONDM||T01.BONDJ = '061025' AND " & _
"T01.COVEN = ' V12' "
' Pour avoir notre champ Date1 nous faisons une concaténation et nous mettons dans la condition Where une date quelconque, car l'As400 n'accepte pas directement la variable. ‘Nous ‘remplaçons la valeur bidon de la date par le contenu de la variable
strsql = Replace(strsql, "'061025'", Chr(39) & Dat & Chr(39))
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
' Ouverture de la table et remplissage
Rsdb.Open "[Tbl_Import_Ca]", Cnndb, adOpenKeyset, adLockOptimistic
End If
' Attribution des valeurs aux champs correspondants
With Rsdb
AddNew Array("N°_Bon", "Code_Ven", "Date1", "Code_client", "CA_Bon", "Nom_Ven"),
Array(Champ1, Champ2, Champ3, Champ4, Champ5, Champ6).Update
End With
RsAs400.MoveNext
Loop
' Ferme la connexion
RsAs400.Close
Set RsAs400 = Nothing
Set Rsdb = Nothing
Set CnnAs400 = Nothing
Set Cnndb = Nothing
La Table est remplie et il faut maintenant s'occuper du dernier champ qui nous intéresse
c'est à dire le champ "Date_Bon". Nous allons nous servir de la fonction Update.
DoCmd.SetWarnings False 'Stoppe les messages d'alerte
DoCmd.RunSQL "Update Tbl_Import_Ca Set Date_Bon " & _
"= Right([Date1],2) & '/' & Mid([Date1],3,2) & '/' & Left([Date1],2)"
DoCmd.SetWarnings True
End Function
Partager