Pass Parameters from VBA to AS400

speed88bump

New Member
Joined
Aug 9, 2013
Messages
29
Synopsis: I have made an ODBC connection within an excel sheet that connects directly to the AS400 database. It brings it in as a table when refreshed. I am wanting to pass the parameters in the sheet to the AS400 and then refresh the data, as I have found this to be much faster and more efficient than returning the data cell by cell.

Problem/Opportunity: When the code reaches 'Clear Work Files it errors out and I do not think it is my library fields (now changed to xxx as it is proprietary) I think it may be as simple as a comma or bracket placed incorrectly towards the end of the statement.
Also, I am not sure I am even passing the parameters correctly. Parm1-3 will always reflect the same data. However, Parm4 it needs to go through each cell starting in A2 until Last Row and input that into AS400. My question here is how should it do that? Use a between statement (Between A2 and Last Row), Use an And Statement for each cell adding it to the query? List and list each part number from each cell?

The code below may have some extra Public Declarations in it but that is only because this code has changed so many times and I have not had a chance to go through them and clear the unused ones out.

I am a newbie so don't assume I know, please show me example in code.

Public i As Long
Public x As Long
Public FirstRow As Long
Public ChangeRow As Long
Public Lastrows As Long
Public HdrRowT As Long
Public HdrRowB As Long
Public Rng As Range
Public Row As Long
Public SystemAccess As String
Public LogIn As String
Public Userid As String
Public Pword As String
Public Lib As String
Public Libf As String
Public LibT As String
Public Libf1 As String
Public Parm1 As String
Public Parm2 As String
Public Parm3 As String
Public Parm4 As String
Public CloseLogInForm As String
Public ChagedCell As String
Public f As Long
Public t As Long
Public ClearSt As String

Sub Refresh_Data()

Dim svr As New ADODB.Connection
Dim Rs As ADODB.Recordset

Set My_Range = Range("A2:B" & LastRow(ActiveSheet))
My_Range.Parent.Select

'Verify connection to AS400
If LogIn <> "1" Then
Call Access

End If

'Control events in screen
ActiveSheet.Select
ActiveSheet.Unprotect
'Application.ScreenUpdating = False
'Application.EnableEvents = False

Lib = "XXXXXXX"
LibT = "XXXXXXX"
Libf = "XXXXXX"
svr.Open "provider=IBMDA400;data source=137.168.XXX.XXX;User ID=" & Userid & "; Password=" & Pword

If Err Then
MsgBox "Verify your credentials"
Exit Sub
End If

'Clear work files
'Set Rs = svr.Execute("{{CALL /XXXXXXX.LIB/" & Lib & ".LIB/XXXXXX.PGM}}," - 1, Rcds)

If Err Then
MsgBox Error
svr.Close
Exit Sub
End If

With Sheets("Data Input")
'loop through each cell starting in A2 until lRow is reached
lRow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & lRow)

Parm1 = Range("D2") 'Company
Parm2 = Range("E2") 'Route
Parm3 = Range("F2") 'Shrinkage
Parm4 = cell.Value 'Item#


'Send parameters from Worksheet to AS400 Program
Set Rs = svr.Execute("{{CALL /XXXXXXX.LIB/" & Lib & ".LIB/XXXXXX.PGM('" & Parm1 & "' '" & Parm2 & "' '" & Parm3 & "' '" & Parm4 & "')}}", -1, Rcds)

If Err Then
MsgBox Error
svr.Close
Exit Sub
End If
Exit For

Next cell

'Control events in screen
ActiveSheet.Select
‘There is a data connection already within the workbook so after the parameters have been passed the
‘Workbook refreshes that data connection with the new parameters
ActiveWorkbook.RefreshAll

End With
End Sub




Sub Access()

LogInForm.Show
'LogIn = LogInForm.logVal.Text
Userid = LogInForm.UserIdB.Text
Pword = LogInForm.PWordB.Text
SystemAccess = LogInForm.SystemButton1.Value

End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Forum statistics

Threads
1,215,326
Messages
6,124,256
Members
449,149
Latest member
mwdbActuary

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top