Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Call AS400 Program in VB

Status
Not open for further replies.

RiverGuy

Programmer
Jul 18, 2002
5,011
US
Hi all. Does anyone know how I can call I program and feed it parameters from within VB?
 
Public as400 As New cwbx.AS400System
Public pgm As New cwbx.Program
Public cmd As New cwbx.Command
Public param1 As New cwbx.ProgramParameters
Public as400systems As New cwbx.SystemNames
Public strCvtr As New cwbx.StringConverter
On Error GoTo RunProg
as400.Define UCase(as400systems.DefaultSystem)
Set pgm.System = as400
pgm.System.UserID = "UserID"
pgm.System.Password = "Password"
as400.Signon

RunProg:

pgm.libraryName = "Libary"
pgm.programName = "Program"

param1.Clear

param1.Append "Parameter name", cwbrcInput, 8
param1("Parameter name") = strCvtr.ToBytes(String)

pgm.Call param1
pgm.Call
----------------------------
'Parameter name must be the same as in PLIST in called program
'cwbrcInput can also be cwbrcoutput or cwbrcBoth
'In you "references" in vb program "IBM AS/400 client access Expres Active Object Library" must be ticked.
'When you load Clienbt access express make sure you load the correct components.
 
I tried something like this but it's not working for me. I'm not familiar with RPG so I have to rely on our resident RPG Programmer.

For testing purposes, he wrote this

0001.00 C *ENTRY PLIST
0002.00 C PARM PMCIN 10
0003.00 C MOVEL'HI TRENT'PMCRTN P
0004.00 C SETON LR

And I tried this from VBA

Option Compare Database

Public as400 As New cwbx.AS400System
Public pgm As New cwbx.Program
Public cmd As New cwbx.Command
Public param1 As New cwbx.ProgramParameters
Public as400systems As New cwbx.SystemNames
Public strCvtr As New cwbx.StringConverter

Sub Working()

On Error GoTo ErrHandler

as400.Define UCase(as400systems.DefaultSystem)
Set pgm.system = as400
pgm.system.UserID = "WEBUSER"
pgm.system.Password = "XA51Z3"
as400.Signon

pgm.libraryName = "ALBLIB"
pgm.programName = "PARMTEST"

param1.Clear

param1.Append "PMCIN", cwbrcInput
param1("PMCIN") = strCvtr.ToBytes("AAAAAAAAAA")

pgm.Call param1
pgm.Call

ErrHandler:
MsgBox "Error Number = " & Err.Number & vbCr & _
"Error Description = " & Err.Description & vbCr & _
"Error Source = " & Err.Source & vbCr & _
"Client Access Return Code = " & cmd.Errors.ReturnCode

For Each cwbErr In cmd.Errors
MsgBox "Client Access Message Text: " & vbCr & cwbErr.Text
Next

End Sub

-----------------------------------
It's calling the RPG program but apparently not passing the values, I've tried changing the data types on my end with no luck. Do I need to ask our RPG guy to change something on his end?
 
Below is a program in RPG (SQLRPGLE) that i am using and that works 100%. I am using the input paramter as a perameter for my SQL selection criteria. This program runs for about a second on a 750 000 record file. We are running an entry level iseries 820.
The sql message codes print on error will give you a good indication if someting goes wrong, e.g. incorrect parameter, etc.

There is nothing fancy otherwise.
Maybe don't pass the paramter directly. Put your variable into a defined string (dim str as string str = 'AAAAAAAAAA') and maybe that will help.

Good luck
Tilo

H DFTNAME(REQACT)
H*************************************************************************
H* REQACT : Rquisition Actual *
H* Written By : Tilo von Brandis *
H* Date : 2002/04/17 *
H*************************************************************************
FQPRINT O F 132 Printer
F*************************************************************************
D*
D*************************************************************************
C *ENTRY PLIST
C PARM WPNum 8
C*
C/EXEC SQL WHENEVER SQLERROR GOTO RPTERR
C/END-EXEC
C*
C/EXEC SQL
C+ DELETE FROM COSTING/REQACT
C/END-EXEC
C*
C/EXEC SQL
C+ INSERT INTO COSTING/REQACT
C+ SELECT
C+ PWDOCTYPE,
C+ PWWP#,
C+ PWIT#,
C+ PWDOCORIG,
C+ PWDOCOIT#,
C+ PWWO#,
C+ PWCENTRE,
C+ PWDOC#DESC,
C+ PWDOC11 || PWDOC12,
C+ PWDOCIT1,
C+ PWLDATEC,
C+ PWSUPP,
C+ PWSUPPDESC,
C+ PWPN,
C+ PWTRQTY,
C+ PWTRVAL,
C+ PWPNTYPE,
C+ PWPNDESC,
C+ '',
C+ ''
C+ FROM DAYENDLIB/SWPDET
C+ WHERE PWDOCTYPE = 'RQ '
C+ AND PWWP# = :WPNUM
C+ AND PWCENTRE in ('PO','RO','SO')
C+ ORDER BY PWDOCTYPE,PWSUPP,PWLDATEC,PWPN
C/END-EXEC
C*
C GOTO END
C*
C RPTERR TAG
C* -----------------
C EXCEPT RECE
C*
C END TAG
C* ------------------
C SETON LR
O*************************************************************************
OQPRINT E RECE 1 1
O 28 '*** ERROR Occurred while'
O 52 ' updating table. SQLCODE'
O 53 '='
O SQLCOD L 62
O E RECE 0 1
O SQLERL L 75
O E RECE 0 1
O SQLERM 75
O E RECE 0 1
O SQLERP 75
O E RECE 0 1
O SQLER1 L 75
O E RECE 0 1
O SQLAID 75
O E RECE 0 1
O SQLABC L 75
O E RECE 0 1
O 75 '*------------*'
 
tbonevb,

Your post seems helpful. I need to try this stuff again. I suppose if I wanted to do a straight SQL instead of using ODBC, I'd make a command object?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top