VBA Passthrough Query

Rood67 · July 16th, 2009, 11:47 AM

I can create views on the AS400. That is what has dramatically increased the speed of my Excel workbooks that tie directly to a view instead of me running my queries in Access to refresh the local tables, then letting Excel pull from the local Access tables. Using the view is fast and eliminates the extra step.

As for creating a procedure on the 400, I don't know if the admins that directly run the host would let me even attempt that. And for what they charge per hour, I'm not going to lay it out and have them create it for me.

I'm starting on building my code my code for doing some selects from the 400. Then I'll progress to writing the pulled data to local tables. On that, i'll use you're point and not concatenate on the fly. I'll see if I can't rework some of my other things to use the separated date fields or run separate update against the newly refreshed local table to do the concatenation.

I have some of the WROX books. I have always highly valued the layout and flow of their writing. However, here lately, they have been getting severely bashed on Amazon reviews. I take those with a grain of salt and go look for a copy locally at Borders or Barnes & Noble so I can see for myself. There are a few books that I have to agree, the quality is lacking compared to earlier editions.

I'll definately look into the books you recommended.

And as always, I'm in your debt for the great advise, pointers, and straight up answers you've provided over that past few days on this issue. I feel better about striking out and putting concept to action now.

Scott

Rood67 · September 17th, 2009, 08:16 PM

Mac,

I finally got to get back to this project. I also, finally found a connection string that allows me to use OLE DB for a DSN-less connection to the AS400 and allows for ADO recordset reads from the AS400. *Listen, you can still hear the angels singing*

I have tried dozens of code changes to get your example to take the read in data and write it to a local table. Here is the code I'm working with.

Code:

Private Sub cmdRecordset_Click()
On Error GoTo Err_cmdRecordset_Click

Dim sSQL, sSQLL As String
Dim rs, rsL As ADODB.Recordset
Dim cn, cnL As ADODB.Connection
Dim sCriteria As String
 
'Take parameter
If IsNull(Me.txtCriteria) Or Me.txtCriteria = "" Then 'Date is text field
   sCriteria = ""
Else
  sCriteria = " WHERE MOFSTD = '" & Me.txtCriteria & "'"
End If

sSQLL = "SELECT * FROM tbl_cupmmof_TEST"

'Clear out old data *except an empty table causes script to crash*
'DoCmd.SetWarnings False
'DoCmd.RunSQL "DELETE * FROM tbl_cupmmof_TEST"
'DoCmd.SetWarnings True
 
sSQL = "SELECT trim(MOFICD) as MOFICD" & _
     ", trim(MOFMNM) as MOFMNM" & _
     ", trim(MOFTLE) as MOFTLE" & _
     ", MOFSTD" & _
     ", trim(MOFFRM) as MOFFRM" & _
     ", trim(MOFBOX) as MOFBOX" & _
     ", trim(MOFGNR) as MOFGNR" & _
     ", trim(MOFSDO) as MOFSDO" & _
     ", trim(MOFRTG) as MOFRTG" & _
     ", trim(MOFRNK) as MOFRNK" & _
     ", trim(MOFTHM) as MOFTHM" & _
     ", MOFQOO, MOFTYP" & _
     " FROM PRODTA.CUPMMOF"
sSQL = sSQL & sCriteria
 
'Open connection to AS400 and local database
Set cn = New ADODB.Connection
Set cnL = New ADODB.Connection

cn.Open "Provider=IBMDA400;Data source=10.1.129.3;User Id=my_id;Password=my_pw"
cnL.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\Scott\My Documents\Scott\Access\MakeTablesMagnatron.mdb;Persist Security Info=False"

'Open recordset on CUPMMOF table
Set rs = New ADODB.Recordset
rs.Open sSQL, cn, adOpenDynamic, adLockOptimistic

'Open recordset to local table
Set rsL = New ADODB.Recordset
rsL.Open sSQLL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
 
rs.MoveFirst
Debug.Print "AS400"
Do Until rs.EOF
  Debug.Print rs.Fields("MOFICD"), rs.Fields("MOFTLE")
  
  rsL.Fields("ItemCode") = rs.Fields("MOFICD")
  rsL.Fields("Title") = rs.Fields("MOFTLE")
  
  rs.MoveNext
  rsL.Update
'Kills the code, but without moving forward, everything just goes into record 1
'  rsL.MoveNext
Loop

rsL.MoveFirst
Debug.Print "Local"
Do Until rsL.EOF
  Debug.Print rsL.Fields("ItemCode"), rsL.Fields("Title")
  rsL.MoveNext
Loop

Set rs = Nothing
Set rsL = Nothing
Set cn = Nothing
Set cnL = Nothing

Exit_cmdRecordset_Click:
    Exit Sub

Err_cmdRecordset_Click:
    MsgBox Err.Description
    Resume Exit_cmdRecordset_Click
    
End Sub

This works beautifully except the following huge glaring exceptions.

Unless the output recordset has at least one record, the script crashes stating BOF or EOF has been reached.
Without some way to move forward through the output recordset, everything read in from the AS400 goes to record one in the output.

Can you see what it is that I'm doing wrong?

Rood67 · September 18th, 2009, 12:36 PM

**SOLVED**

I had to use the .AddNew method on the local table to get it to create the record to be written to. Here is the complete code that resolves:

Connecting to the AS400
Running a dynamic query
Taking the resulting recordset and putting it into a local table

Code:

Private Sub cmdRecordset_Click()
On Error GoTo Err_cmdRecordset_Click

Dim sSQL, sTBL As String
Dim rs, rsL As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sCriteria As String
 
'Take parameter from form
If IsNull(Me.txtCriteria) Or Me.txtCriteria = "" Then 'Date is text field
   sCriteria = ""
Else
  sCriteria = " WHERE MOFSTD = '" & Me.txtCriteria & "'"
End If

sTBL = "tbl_cupmmof_TEST"

'Clear out old data
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tbl_cupmmof_TEST"
DoCmd.SetWarnings True

'Query to run against AS400 data
sSQL = "SELECT trim(MOFICD) as MOFICD" & _
     ", trim(MOFMNM) as MOFMNM" & _
     ", trim(MOFTLE) as MOFTLE" & _
     ", MOFSTD" & _
     ", trim(MOFFRM) as MOFFRM" & _
     ", trim(MOFBOX) as MOFBOX" & _
     ", trim(MOFGNR) as MOFGNR" & _
     ", trim(MOFSDO) as MOFSDO" & _
     ", trim(MOFRTG) as MOFRTG" & _
     ", trim(MOFRNK) as MOFRNK" & _
     ", trim(MOFTHM) as MOFTHM" & _
     ", MOFQOO, MOFTYP" & _
     " FROM PRODTA.CUPMMOF"
sSQL = sSQL & sCriteria
 
'Create connection to AS400
Set cn = New ADODB.Connection

'Open connection to AS400
cn.Open "Provider=IBMDA400;Data source=xxx.xxx.129.3;User Id=my_id;Password=my_pw"

'Open recordset on CUPMMOF table
Set rs = New ADODB.Recordset
rs.Open sSQL, cn, adOpenDynamic, adLockOptimistic

'Open recordset to local table
Set rsL = New ADODB.Recordset
rsL.Open sTBL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
 
rs.MoveFirst
Debug.Print "AS400"
Do Until rs.EOF
  Debug.Print rs.Fields("MOFICD"), rs.Fields("MOFTLE")
  rsL.AddNew 'Heres the elusive bugger that was the source of so many errors until it was discovered
  rsL.Fields("ItemCode") = rs.Fields("MOFICD")
  rsL.Fields("Title") = rs.Fields("MOFTLE")
  rsL.Update
  rs.MoveNext
Loop

'Test to check if above code actually worked
rsL.MoveFirst
Debug.Print "Local"
Do Until rsL.EOF
  Debug.Print rsL.Fields("ItemCode"), rsL.Fields("Title")
  rsL.MoveNext
Loop

'Clear memory
Set rs = Nothing
Set rsL = Nothing
Set cn = Nothing

'Force VBA screen to open if not already showing
Stop

Exit_cmdRecordset_Click:
    Exit Sub

Err_cmdRecordset_Click:
    MsgBox Err.Description
    Resume Exit_cmdRecordset_Click
    
End Sub

Now some minor clean up to get rid of the test code that displays the local table data, add in the other fields, and start coding all the other tables that I need to pull data from dynamically.

Mac - words fail me to express my gratitude for getting me going in the right direction with this. Thank you very much.

drestivo · May 1st, 2012, 04:20 PM

I am very new here and not really that great with the sql and vba stuff I am basically winging things

I tried creating a pass through query but I keep getting an ODBC error. I followed all the steps and yet It failed me.

Can you please advise what I can do to resolve.

Thanks