Hello to All,
I'm trying to retrieve records from AS/400 in an VBA application.
So, I've made an RPG program, then a stored procedure wchich calls that RPG
program, and finally some VBA code to call the stored procedure and retrieve
data from AS/400.
The problem is, that when I finally run my VB code, it just hangs.
But when I call the same stored procedure from "pure" SQL - it works
perfect. (I evaluate Aqua Data Studio 3.7)
What I find interesting, is that when I execute through my VBA any simple
SQL statement like "SELECT * FROM MYLIB.MYTABLE" it works and returns data.
It works also when I call an SQL-only stored procedure. Problems begin, when
I try to call a stored procedure wchich calls an external RPG program.
(Please see code below)
For now there are two things I suppose to be reasons for my problem:
1) I should declare a cursor in the stored procedure and leave it open for
the client application, but I just don't know how to do this together with
the "EXTERNAL NAME" clause;
2) I make a mistake in the connection string in VBA - here I also have no
idea what I do wrong
Well, the third case could be, that I do everything correct, but there are
new undocumented bugs in Microsoft Access ;-)
I hope I described my problem transparent enough.
Did anybody have such problems?
Below are the three sources: stored procedure, RPG program and VBA code.
Thanks for any help!
Greetings from Poland
WW
************************************************** ******************
******* STORED PROCEDURE *******
************************************************** ******************
CREATE PROCEDURE MYLIB.P3(
in SOC char(1),
in ENS char(1),
in CUST char(10)
)
RESULT SETS 1
LANGUAGE RPG
SPECIFIC MYLIB.P3
NOT DETERMINISTIC
CONTAINS SQL
EXTERNAL NAME bpl400.sp3
PARAMETER STYLE GENERAL ;
************************************************** ******************
******* RPG PROGRAM *******
************************************************** ******************
0001.00 FSGSELCJ1IF E K DISK
0002.00 *
0003.00 IV99999 E DSSGSELCJ1 1
0004.00 C Z-ADD1 ROW 10
0005.00 C *ENTRY PLIST
0006.00 C PARM SOC 1
0007.00 C PARM ENS 1
0008.00 C PARM CUST 10
0009.00 C MOVE CUST KBCUST 100
0010.00 C KEY1 KLIST
0011.00 C KFLD SOC
0012.00 C KFLD ENS
0013.00 C KFLD KBCUST
0014.00 C KEY1 CHAINSGSELCJ1 50
0015.00 C *IN50 IFEQ *OFF
0016.00 C 1 DO 1 I 30
0017.00 C I OCUR V99999
0018.00 C READ SGSELCJ1 99
0019.00 C END
0020.00 C*GOOD NUMBER
0021.00 C/EXEC SQL SET RESULT SETS ARRAY :V99999 FOR :ROW ROWS
0022.00 C/END-EXEC
0023.00 C ELSE
0024.00 C*BAD NUMBER
0025.00 C END
0026.00 C RETRN
************************************************** ******************
******* VBA PROCEDURE *******
************************************************** ******************
Public Sub ASquery()
Dim CNN As New ADODB.Connection
Dim CMD As New ADODB.Command
Dim RST As New ADODB.Recordset
Dim i, dl, ri As Integer
Dim sHeader, sRecord As String
'=======================
'Set and open connection
'=======================
CNN.Open "Provider=MSDASQL.1;USER=USR;" & _
"PASSWORD=PASS;Persist Security Info=False;" & _
"Data Source=MYSOURCE"
With CMD
.ActiveConnection = CNN
.CommandText = "call MYLIB.P3('1', '1', '0028351372')"
End With
'=======================
'Fetch data into Recordset
'=======================
Set RST = CMD.Execute
'=======================
'Retrieve column headers
'=======================
i = 0
sHeader = ""
For i = 0 To RST.Fields.Count - 1
sHeader = sHeader & RST.Fields.Item(i).Name & vbTab
Next i
Debug.Print sHeader
'=======================
'Retrieve data fields
'=======================
While RST.EOF = False
For ri = 0 To RST.Fields.Count - 1
sRecord = sRecord & RST.Fields.Item(ri) & vbTab
Next ri
Debug.Print sRecord
If RST.EOF = False Then RST.MoveNext
sRecord = ""
Wend
End Sub
