By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
426,234 Members | 1,832 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 426,234 IT Pros & Developers. It's quick & easy.

Final solution on copy a recordset?

P: n/a
Hi! I was a little too fast, because I had a new crash in what I
thought was a solution.
Then I discovered Allen Browne's webpage:
members.iinet.au/~allenbrowne, and found a
procedure I thought I could try. And now after testing and testing
and...it finally
seems to work! Don't ask me why. I moderated Allen's code a little
bit. :-)

Private Sub CopyRecordsetWithUnderlyingTablesToNewRecord_Click

Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim bInTrans As Boolean
Dim rs As DAO.Recordset
Dim sqlNew As String, strOnr As String
Dim lngNewOrderID As Long, lngKID As Long

On Error GoTo Err_COPY

Me.Refresh

lngKID = Me!CustID
strOnr = DMax("[Invoicenr]", "tblOrders") + 1
sqlNew = ""

Set ws = DBEngine(0)
ws.BeginTrans
bInTrans = True

Set db = ws(0)
Set rs = db.OpenRecordset("tblOrders", dbOpenTable)

rs.AddNew
rs!Invoicenr = strOnr
rs!CustID = lngKID
rs!MyDate = Date
rs!MyTime = Time
rs.Update
rs.Bookmark = rs.LastModified
lngNewOrderID = rs!InvoiceID

sqlNew = "INSERT INTO
tblOrderDetails(ItemID,Amount,Discount,Price,Fee,I nvoiceID) " & _
"SELECT ItemID,Amount,Discount,Price,Fee,," & lngNewOrderID & _
" FROM tblOrderDetails " & _
"WHERE InvoiceID = " & Me!InvoiceID

CurrentDb.Execute sqlNew, dbFailOnError

If MsgBox( _
"SURE U WILL COPY INVOICENR: " _
& Me!Invoicenr & "?", vbOKCancel, "COPY?") = vbOK Then

ws.CommitTrans
bInTrans = False
End If

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

'However in order to have the new added record show, I can't make it
show unless
'I do the following:

DoCmd.Close acForm, "frmOrders"

'Now open a splash screen for .500 sec
DoCmd.OpenForm "DESIGNER", acNormal
'And when the splash screen closes, it will call "frmOrders"
'Quite genious, huh?

Exit_COPY:
On Error Resume Next
Set rs = Nothing
Set db = Nothing
If bInTrans Then
ws.Rollback
End If
Set ws = Nothing

Exit Sub
Err_COPY:
MsgBox Err.Source & Chr(13) _
& Err.Number & " " & "ORDERS/COPY" & Chr(13) _
& Err.Description, vbCritical + vbOKOnly
Resume Exit_COPY
End Sub

Is there anybody out there that would dare to tell me what's going on?
Nov 13 '05 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.