Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
Password Reminder
Register
| FAQ | Members List | Search | Today's Posts | Mark Forums Read
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #11 (permalink)  
Old July 16th, 2009, 11:47 AM
Authorized User
 
Join Date: Mar 2004
Location: Knoxville, TN, USA.
Posts: 26
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via MSN to Rood67
Default

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
__________________
<b>Rood67</b>
Reply With Quote
  #12 (permalink)  
Old September 17th, 2009, 08:16 PM
Authorized User
 
Join Date: Mar 2004
Location: Knoxville, TN, USA.
Posts: 26
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via MSN to Rood67
Default

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.
  1. Unless the output recordset has at least one record, the script crashes stating BOF or EOF has been reached.
  2. 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?
__________________
<b>Rood67</b>
Reply With Quote
  #13 (permalink)  
Old September 18th, 2009, 12:36 PM
Authorized User
 
Join Date: Mar 2004
Location: Knoxville, TN, USA.
Posts: 26
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via MSN to Rood67
Thumbs up Pass Through Query to AS400 **SOLVED**

**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:
  1. Connecting to the AS400
  2. Running a dynamic query
  3. 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.
__________________
<b>Rood67</b>

Last edited by Rood67; September 18th, 2009 at 12:42 PM..
Reply With Quote
  #14 (permalink)  
Old May 1st, 2012, 04:20 PM
Registered User
Points: 3, Level: 1
Points: 3, Level: 1 Points: 3, Level: 1 Points: 3, Level: 1
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: May 2012
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Unhappy Create a Pass Through Query

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
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
how to open an existing query in VBA michael193nj Access VBA 4 March 26th, 2008 05:09 PM
passthrough password BlueSkies Access 2 August 28th, 2006 06:29 AM
Help With SQL Query in VBA Paul_Tic Access VBA 4 May 30th, 2006 06:34 AM
VBA Query Problems LiamBFC Access VBA 2 April 11th, 2006 06:26 AM
passthrough query Snowingnow Access 3 November 23rd, 2004 11:47 AM



All times are GMT -4. The time now is 01:54 AM.


Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.