Figures

)

/* Get name of the first member */
RtvMbrD File( Test ) +
Mbr( *FirstMbr ) +
RtnMbr( &MbrName )
MonMsg ( CPF3049 ) +
Exec( Do )

/* Insert code to handle file with no-members error */
EndDo

/* Get the name of the &MbrNum member */
ChgVar &Count 1

Loop1:
If ( &Count *Lt &MbrNum ) +
Do
ChgVar &Count ( &Count + 1 )
RtvMbrD File( Test ) +
Mbr( &MbrName *Next ) +
RtnMbr( &MbrName )

MonMsg ( CPF3049 ) +
Exec( Do )

/* Insert code to handle not-enough-members error */
EndDo
GoTo Loop1
EndDo

/* Issue override/call commands */
Loop2:
OvrDbf File( Test ) +
Mbr( &MbrName )
Call Test2
DltOvr Test
RtvMbrD File( Test ) +
Mbr( &MbrName *Next ) +
RtnMbr( &MbrName )
MonMsg ( CPF3049 ) +
Exec( Goto Exit )
GoTo Loop2
Exit:
EndPgm

Figure 1 (bis)
Exemple d’entrée ID utilisateur pour Client Access Express

[HKEY_CURRENT_USER\Software\IBM\Client Access Express\CurrentVersion\EnvironmentsMy AS/400 Connections\MyAS400\Communication]
"Signon Mode"=dword:00000001
"User ID"="MJONES"

Figure 2
SQL source pour créer une procédure cataloguée

CREATE PROCEDURE MyPgmLib.MySP (in Field1 Numeric(9), in Field2 Char(15), in Field3 Char(3))
LANGUAGE SQL
BEGIN
INSERT INTO MyDtaLib.MyTable (Fld1Name, Fld2Name, Fld3Name)
VALUES(Field1, Field2, Field3);
END;
-- Excel VBA code to call the stored procedure. --
Public Sub UpLoadToAS400()
' Excel VBA code to call a stored procedure
' Note - Add a reference to Microsoft ActiveX Data Objects Library (under tools/references
menu)
'
'
Dim MySystem As New ADODB.Connection
Dim MyProgram As New ADODB.Command
Dim Row As Integer
Dim LastRow As Integer
LastRow = 5 ' Example code to upload 5 records. Adjust this for your data.
' Open ADO connection to AS/400
MySystem.Open "Provider=IBMDA400;Data Source=MyAS400Sys;", "", ""
MySystem.Execute "{{CHGLIBL LIBL(MyPgmLib MyDtaLib QGPL)}}", Rcds, adCmdText
' Set parameters for call.
Set MyProgram.ActiveConnection = MySystem
MyProgram.CommandText = "{CALL MyPgmLib.MySP(?,?,?)}"
MyProgram.Prepared = True
' Call MyProgram for each entry.
For Row = 2 To LastRow
DoEvents
Cells.Range("A" & Trim(Row), "C" & Trim(Row)).Select
Parms = Array(Cells(Row, 1).Value, Cells(Row, 2).Value, Cells(Row, 3).Value)
MyProgram.Execute Rcds, Parms, adCmdText
Next
Set MyProgram = Nothing
MySystem.Close
End Sub

Figure 3A
Affichage de Dtlr et Qty

D DtlR E DS ExtName( P767DS01 )
D Qty S 5P 0 Dim( 5 )

Figure 3B
DDS pour le fichier P767DS0I

A STYLE 15A
A DESCRN 20A
A QTY1 5P 0
A QTY2 5P 0
A QTY3 5P 0
A QTY4 5P 0
A QTY5 5P 0

Figure 3C
Définition des champs Qtyn dans un tableau

D DtlR E DS ExtName( P767DS01 )
D DtlRPtr S * Inz( %Addr( Qty1 ) )
D Qty S Like( Qty1 )
D Dim( 5 )
D Based( DtlRPtr )