Adding record failure using nested loops in vba

  • Thread starter pubdude2003 via AccessMonster.com
  • Start date
P

pubdude2003 via AccessMonster.com

hey all,

I have some code that is intended to dupe a set of records in a table and
related table.

It works fine for the first table duping as many records as appear in the
original set but when it comes to duping the records in the related table it
only writes the first related record and then stops, ignoring any additional
Autonumber related records.

My code;

-----------------------------
lngID = ![Job / Estimate Number]

If Me.[Prices].Form.RecordsetClone.RecordCount > 0 Then
Dim db As DAO.Database
Dim PricesRs(1 To 3) As DAO.Recordset
Dim CalcsRs(1 To 3) As DAO.Recordset
Dim PricesID As Integer
Dim ix As Single

ix = 1

Set db = CurrentDb
Set PricesRs(1) = db.OpenRecordset("SELECT * FROM [1 Printing Price] WHERE
[Job / Estimate Number] = " & Me.[Job / Estimate Number])
Set PricesRs(2) = PricesRs(1).Clone
Set PricesRs(3) = PricesRs(1).Clone

Do Until ix > (Me.[Prices].Form.RecordsetClone.RecordCount)
PricesRs(3).AddNew
PricesID = PricesRs(3)![Autonumber]
PricesRs(3)![Job / Estimate Number] = lngID
PricesRs(3)![Q 1] = PricesRs(2)![Q 1]
PricesRs(3)![Q 1 Header] = PricesRs(2)![Q 1 Header]

PricesRs(3).Update 'Must do update here as the Calcs table requires the
record to be saved.


'Create the associated CALCS record
Set CalcsRs(1) = db.OpenRecordset("SELECT * FROM [Calcs] WHERE [Autonumber] =
" & PricesRs(1)!(Autonumber])
Set CalcsRs(2) = CalcsRs(1).Clone
Set CalcsRs(3) = CalcsRs(1).Clone

Do Until CalcsRs(1).EOF
CalcsRs(3).AddNew
CalcsRs(3)![Estimate Number] = lngID
CalcsRs(3)![Autonumber] = PricesID
CalcsRs(3)![Ref] = CalcsRs(2)![Ref]
CalcsRs(3)![1] = CalcsRs(2)![1]
CalcsRs(3)![hiddensym1] = CalcsRs(2)![hiddensym1]
CalcsRs(3)![descript1] = CalcsRs(2)![descript1]
CalcsRs(3)![2] = CalcsRs(2)![2]
CalcsRs(3)![hiddensym2] = CalcsRs(2)![hiddensym2]
CalcsRs(3)![descript2] = CalcsRs(2)![descript2]

CalcsRs(3).Update
CalcsRs(1).MoveNext

PricesRs(1).MoveNext
PricesRs(2).MoveNext
Exit Do
Loop
ix = ix + 1
Loop
 
P

pubdude2003 via AccessMonster.com

I have been crunching away at this thing all night and I have discovered that
the line

Set CalcsRs(1) = db.OpenRecordset("SELECT * FROM [Calcs] WHERE [Autonumber] =
" & PricesRs(1)!(Autonumber])

is returning only one record, so this is where it's failing but I have no
idea why, I have double-triple checked and there are definitely two records
satisfying the Select statement. Even if I take the line out of the update
code and pass an absolute value to the Autonumber field it still only returns
a record count of 1 (one).

any ideas... anyone, quite a frustration!
 
P

pubdude2003 via AccessMonster.com

more info, my bad, it is definitely see all of the records it should

something about the

Do Until CalcsRs(1).EOF

is failing after it writes the first record it continues to the top of the
SQL to write the next Prices table record instead of finishing the writing of
the Calcs records
 
P

pubdude2003 via AccessMonster.com

final solution:

the SQL just couldn't seem to see the proper RecordCount so by forcing it
with this

CalcsRs(1).MoveLast
stpLoop = CalcsRs(1).RecordCount

and creating a different Do statement I finally have it solved, far from
elegant but it WORKS!

Dim ix As Single
Dim iy As Single
Dim stpLoop As Single

ix = 1


Set db = CurrentDb
Set PricesRs(1) = db.OpenRecordset("SELECT * FROM [1 Printing
Price] WHERE [Job / Estimate Number] = " & Me.[Job / Estimate Number])
Set PricesRs(2) = PricesRs(1).Clone
Set PricesRs(3) = PricesRs(1).Clone
Do Until ix > (Me.[Prices].Form.RecordsetClone.RecordCount)
PricesRs(3).AddNew
PricesID = PricesRs(3)![Autonumber]
PricesRs(3)![Job / Estimate Number] = lngID
PricesRs(3)![Q 1] = PricesRs(2)![Q 1]
PricesRs(3)![Q 1 Header] = PricesRs(2)![Q 1 Header]
PricesRs(3)![Q 1 DESCRIPTION] = PricesRs(2)![Q 1
DESCRIPTION]
PricesRs(3)![Quoted 1 MPOE D] = PricesRs(2)![Quoted 1
MPOE D]
PricesRs(3)![Quoted 1 MPOE F] = PricesRs(2)![Quoted 1
MPOE F]
PricesRs(3)![Quoted 1 MPOE P] = PricesRs(2)![Quoted 1
MPOE P]
PricesRs(3)![Quoted 1 MPOE B] = PricesRs(2)![Quoted 1
MPOE B]
PricesRs(3)![Quoted 1 MPOE O] = PricesRs(2)![Quoted 1
MPOE O]
PricesRs(3)![Quoted 1 MPOE Db] = PricesRs(2)![Quoted 1
MPOE Db]
PricesRs(3)![Quoted 1 MPOE Fb] = PricesRs(2)![Quoted 1
MPOE Fb]
PricesRs(3)![Quoted 1 MPOE Pb] = PricesRs(2)![Quoted 1
MPOE Pb]
PricesRs(3)![Quoted 1 MPOE Bb] = PricesRs(2)![Quoted 1
MPOE Bb]
PricesRs(3)![Quoted 8 MPOE Bb] = PricesRs(2)![Quoted 8
MPOE Bb]
PricesRs(3)![Quoted 1 MPOE Ob] = PricesRs(2)![Quoted 1
MPOE Ob]
PricesRs(3)![Quoted 1 MPOE MU] = PricesRs(2)![Quoted 1
MPOE MU]
PricesRs(3)![Q1Price] = PricesRs(2)![Q1Price]
PricesRs(3)![IncludeQ1Price] = PricesRs(2)!IncludeQ1Price
PricesRs(3)![OrdereredQ1Price] = PricesRs(2)!
OrdereredQ1Price
PricesRs(3)![ProfitQ1] = PricesRs(2)!ProfitQ1
PricesRs(3)![Q1Desc] = PricesRs(2)!Q1Desc
'Add remaining fields here
PricesRs(3).Update 'Must do update here as the Calcs table
requires the record to be saved.
'PricesRs(1).MoveNext
'PricesRs(2).MoveNext

'Create the associated CALCS record
Set CalcsRs(1) = db.OpenRecordset("SELECT * FROM [Calcs]
WHERE [Autonumber] = " & PricesRs(1)![Autonumber])
Set CalcsRs(2) = CalcsRs(1).Clone
Set CalcsRs(3) = CalcsRs(1).Clone
CalcsRs(1).MoveLast
stpLoop = CalcsRs(1).RecordCount
iy = 1
Do Until iy > stpLoop
'Do Until CalcsRs(1).EOF
CalcsRs(3).AddNew
CalcsRs(3)![Estimate Number] = lngID
CalcsRs(3)![Autonumber] = PricesID
CalcsRs(3)![Ref] = CalcsRs(2)![Ref]
CalcsRs(3)![1] = CalcsRs(2)![1]
CalcsRs(3)![hiddensym1] = CalcsRs(2)![hiddensym1]
CalcsRs(3)![descript1] = CalcsRs(2)![descript1]
CalcsRs(3)![2] = CalcsRs(2)![2]
CalcsRs(3)![hiddensym2] = CalcsRs(2)![hiddensym2]
CalcsRs(3)![descript2] = CalcsRs(2)![descript2]
CalcsRs(3)![3] = CalcsRs(2)![3]
CalcsRs(3)![hiddensym3] = CalcsRs(2)![hiddensym3]
CalcsRs(3)![descript3] = CalcsRs(2)![descript3]
CalcsRs(3)![4] = CalcsRs(2)![4]
CalcsRs(3)![hiddensym4] = CalcsRs(2)![hiddensym4]
CalcsRs(3)![descript4] = CalcsRs(2)![descript4]
CalcsRs(3)![5] = CalcsRs(2)![5]
CalcsRs(3)![hiddensym5] = CalcsRs(2)![hiddensym5]
CalcsRs(3)![descript5] = CalcsRs(2)![descript5]
CalcsRs(3)![6] = CalcsRs(2)![6]
CalcsRs(3)![hiddensym6] = CalcsRs(2)![hiddensym6]
CalcsRs(3)![descript6] = CalcsRs(2)![descript6]
CalcsRs(3)![7] = CalcsRs(2)![7]
CalcsRs(3)![hiddensym7] = CalcsRs(2)![hiddensym7]
CalcsRs(3)![descript7] = CalcsRs(2)![descript7]
CalcsRs(3)![8] = CalcsRs(2)![8]
CalcsRs(3)![descript8] = CalcsRs(2)![descript8]
'Add remaining fields here
CalcsRs(3).Update
CalcsRs(1).MoveNext
CalcsRs(2).MoveNext

iy = iy + 1
Loop


PricesRs(1).MoveNext
PricesRs(2).MoveNext
'Exit Do
'Loop
ix = ix + 1
Loop
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top