 |
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 software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
|
|
|

July 16th, 2009, 11:47 AM
|
Authorized User
|
|
Join Date: Mar 2004
Posts: 26
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
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>
|

September 17th, 2009, 08:16 PM
|
Authorized User
|
|
Join Date: Mar 2004
Posts: 26
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
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?
__________________
<b>Rood67</b>
|

September 18th, 2009, 12:36 PM
|
Authorized User
|
|
Join Date: Mar 2004
Posts: 26
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
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: - 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.
__________________
<b>Rood67</b>
Last edited by Rood67; September 18th, 2009 at 12:42 PM..
|

May 1st, 2012, 04:20 PM
|
Registered User
|
|
Join Date: May 2012
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
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
|
|
 |