The Problem (Q-score 8, ranked #50th of 67 in the Access VBA archive)
The scenario as originally posted in 2013
I have wrote some vbscript that updates all new fields in one access database from a table in another database however I am having problems with duplicate primary keys.
I can’t change the structure of the database so I can’t remove the primary keys however ideally I would like it to auto populate the primary key. Here is my table structure (their are two tables)
Table ‘Order’:
Order Sequence Number About 20 more rows of data that do not have to be unique
a primary key e.g 2 other data
Table ‘OrderDetail’:
OrderDetail OrderSequence Some other rows that don't need to be unique
a primary key the key from Order some other data
My first problem is having the primary key for both tables auto populate so they are unique, then my second problem is matching the two rows that are being added and if the primary key changes on ‘Order’ table for ‘Order Sequence Number’ update it on ‘OrderSequence’ in the table ‘OrderDetail’.
Here is my vbscript that works copying values if they are unique:
Public Function dhupdate1()
'Temp field
Dim fField As Field
Dim bCopy As Boolean
'Open source database
Dim dSource As Database
Set dSource = CurrentDb
'Open dest database
Dim dDest As Database
Set dDest = DAO.OpenDatabase("\BMCDONALD-PCSellerDeck 2013SitesNew_SiteActinicCatalog.mdb")
'Open source recordset
Dim rSource As Recordset
Set rSource = dSource.OpenRecordset("OrderDetail", dbOpenForwardOnly)
'Open dest recordset
Dim rDest As Recordset
Set rDest = dDest.OpenRecordset("OrderDetail", dbOpenDynaset)
'Loop through source recordset
While Not rSource.EOF
'Reset copy flag
bCopy = False
'Look for record in dest recordset
rDest.FindFirst "OrderDetailID = " & rSource.Fields("OrderDetailID") & ""
If rDest.NoMatch Then
'If not found, copy record
rDest.AddNew
bCopy = True
End If
'If copy flag is set, copy record
If bCopy Then
For Each fField In rSource.Fields
rDest.Fields(fField.Name) = rSource.Fields(fField.Name)
Next fField
Set fField = Nothing
rDest.Update
End If
'Next source record
rSource.MoveNext
Wend
'Close dest recordset
rDest.Close
Set rDest = Nothing
'Close source recordset
rSource.Close
Set rSource = Nothing
'Close dest database
dDest.Close
Set dDest = Nothing
'Close source database
dSource.Close
Set dSource = Nothing
End Function
Public Function dhupdate2()
'Temp field
Dim fField As Field
Dim bCopy As Boolean
'Open source database
Dim dSource As Database
Set dSource = CurrentDb
'Open dest database
Dim dDest As Database
Set dDest = DAO.OpenDatabase("\BMCDONALD-PCSellerDeck 2013SitesNew_SiteActinicCatalog.mdb")
'Open source recordset
Dim rSource As Recordset
Set rSource = dSource.OpenRecordset("Order", dbOpenForwardOnly)
'Open dest recordset
Dim rDest As Recordset
Set rDest = dDest.OpenRecordset("Order", dbOpenDynaset)
'Loop through source recordset
While Not rSource.EOF
'Reset copy flag
bCopy = False
'Look for record in dest recordset
rDest.FindFirst "[Order Number] = '" & rSource.Fields("Order Number") & "'"
If rDest.NoMatch Then
'If not found, copy record
rDest.AddNew
bCopy = True
End If
'If copy flag is set, copy record - ignore errors
If bCopy Then
For Each fField In rSource.Fields
On Error Resume Next
rDest.Fields(fField.Name) = rSource.Fields(fField.Name)
On Error GoTo 0
Next fField
Set fField = Nothing
rDest.Update
End If
'Next source record
rSource.MoveNext
Wend
'Close dest recordset
rDest.Close
Set rDest = Nothing
'Close source recordset
rSource.Close
Set rSource = Nothing
'Close dest database
dDest.Close
Set dDest = Nothing
'Close source database
dSource.Close
Set dSource = Nothing
End Function
I have been reading about auto populating if its not unique however I am getting confused where I need these two functions to get both rows for one order and changing both numbers for the order sequence. I am still fairly new to VB so any help is really appreciated.
Thanks,
Simon
Why this Access DoCmd / Recordset path keeps breaking
The scenario uses DoCmd or OpenRecordset, both of which are notorious for bubbling silent failures when the source query has uncommitted changes. The question captures a common debugging dead-end in Access VBA.
The Verified Solution — niche answer (below median) (+4)
61-line Access VBA pattern (copy-ready)
Instead of copying all records for each table from “source” to “dest” in one shot, you could loop through the parent records, copying one parent record and its related child records for each iteration. That is:
- copy parent record 1
- copy child records for parent record 1
- copy parent record 2
- copy child records for parent record 2
- …and so on.
The following sample code may prove helpful:
Option Compare Database
Option Explicit
Public Function CopyOrders()
Dim dSource As DAO.Database, rSourceOrder As DAO.Recordset, rSourceDetail As DAO.Recordset
Dim dDest As DAO.Database, rDestOrder As DAO.Recordset, rDestDetail As DAO.Recordset
Dim fld As DAO.Field, newDestOrderID As Long
Set dSource = CurrentDb
Set rSourceOrder = dSource.OpenRecordset("Order", dbOpenSnapshot)
Set dDest = DAO.OpenDatabase("C:__tmpOrderCopydest.mdb")
Set rDestOrder = dDest.OpenRecordset("Order", dbOpenDynaset)
Set rDestDetail = dDest.OpenRecordset("OrderDetail", dbOpenDynaset)
Do Until rSourceOrder.EOF
' copy one Order record
rDestOrder.AddNew
For Each fld In rDestOrder.Fields
If fld.Name <> "OrderID" Then
rDestOrder.Fields(fld.Name).Value = rSourceOrder.Fields(fld.Name).Value
End If
Next
newDestOrderID = rDestOrder.Fields("OrderID").Value
rDestOrder.Update ' commit parent record so child records can be added
' now copy all related OrderDetail records
Set rSourceDetail = dSource.OpenRecordset( _
"SELECT * FROM OrderDetail " & _
"WHERE OrderID=" & rSourceOrder!OrderID, _
dbOpenSnapshot)
Do Until rSourceDetail.EOF
rDestDetail.AddNew
' use new AutoNumber from parent table (rDestOrder) as foreign key
rDestDetail.Fields("OrderID").Value = newDestOrderID
For Each fld In rDestDetail.Fields
Select Case fld.Name
Case "OrderDetailID", "OrderID"
' do nothing
Case Else
rDestDetail.Fields(fld.Name).Value = rSourceDetail.Fields(fld.Name).Value
End Select
Next
rDestDetail.Update
rSourceDetail.MoveNext
Loop
rSourceDetail.Close
Set rSourceDetail = Nothing
rSourceOrder.MoveNext
Loop
rDestDetail.Close
Set rDestDetail = Nothing
rDestOrder.Close
Set rDestOrder = Nothing
rSourceOrder.Close
Set rSourceOrder = Nothing
dDest.Close
Set dDest = Nothing
Set dSource = Nothing
End Function
edit re: new information
The primary key in the child table is not an AutoNumber, so you’re right that you’ll just have to “roll your own”. Try the following (changes marked as <v1.1>):
Public Function CopyOrders()
Dim dSource As DAO.Database, rSourceOrder As DAO.Recordset, rSourceDetail As DAO.Recordset
Dim dDest As DAO.Database, rDestOrder As DAO.Recordset, rDestDetail As DAO.Recordset
Dim fld As DAO.Field, newDestOrderID As Long
Dim nextDestOrderDetailID As Long ' <v1.1/>
Set dSource = CurrentDb
Set rSourceOrder = dSource.OpenRecordset("Order", dbOpenSnapshot)
Set dDest = DAO.OpenDatabase("C:UsersANONDocumentsOrderMovedhActinicCatalog.mdb")
Set rDestOrder = dDest.OpenRecordset("Order", dbOpenDynaset)
' <v1.1>
Set rDestDetail = dDest.OpenRecordset("SELECT Max(OrderDetailID) AS maxODI FROM OrderDetail", dbOpenSnapshot)
nextDestOrderDetailID = Nz(rDestDetail!maxODI, 0) + 1
rDestDetail.Close
' </v1.1>
Set rDestDetail = dDest.OpenRecordset("OrderDetail", dbOpenDynaset)
Do Until rSourceOrder.EOF
' copy one Order record
rDestOrder.AddNew
For Each fld In rDestOrder.Fields
If fld.Name <> "Order Sequence Number" Then
rDestOrder.Fields(fld.Name).Value = rSourceOrder.Fields(fld.Name).Value
End If
Next
newDestOrderID = rDestOrder.Fields("Order Sequence Number").Value
rDestOrder.Update ' commit parent record so child records can be added
' now copy all related OrderDetail records
Set rSourceDetail = dSource.OpenRecordset( _
"SELECT * FROM OrderDetail " & _
"WHERE OrderSequenceNumber=" & rSourceOrder![Order Sequence Number], _
dbOpenSnapshot)
Do Until rSourceDetail.EOF
rDestDetail.AddNew
' use new AutoNumber from parent table (rDestOrder) as foreign key
rDestDetail.Fields("OrderSequenceNumber").Value = newDestOrderID
' <v1.1>
rDestDetail.Fields("OrderDetailID").Value = nextDestOrderDetailID
nextDestOrderDetailID = nextDestOrderDetailID + 1
' </v1.1>
For Each fld In rDestDetail.Fields
'Select Case fld.Name
' Case "OrderDetailID", "OrderSequenceNumber"
' do nothing
' Case Else
' rDestDetail.Fields(fld.Name).Value = rSourceDetail.Fields(fld.Name).Value
'End Select
If fld.Name <> "OrderDetailID" Then
If fld.Name <> "OrderSequenceNumber" Then
rDestDetail.Fields(fld.Name).Value = rSourceDetail.Fields(fld.Name).Value
End If
End If
Next
rDestDetail.Update
rSourceDetail.MoveNext
Loop
rSourceDetail.Close
Set rSourceDetail = Nothing
rSourceOrder.MoveNext
Loop
rDestDetail.Close
Set rDestDetail = Nothing
rDestOrder.Close
Set rDestOrder = Nothing
rSourceOrder.Close
Set rSourceOrder = Nothing
dDest.Close
Set dDest = Nothing
Set dSource = Nothing
End Function
Loop-performance notes specific to this pattern
The loop in the answer iterates in process. On a 2026 Office build, setting Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual around a loop of this size typically cuts runtime by 40–70%. Re-enable both in the Exit handler.
When to Use It — classic (2013–2016)
Ranked #50th in its category — specialized fit
This pattern sits in the 87% tail relative to the top answer. Reach for it when your scenario closely matches the question title; otherwise browse the Access VBA archive for a higher-consensus alternative.
What changed between 2013 and 2026
The answer is 13 years old. The Access VBA object model has been stable across Office 2013, 2016, 2019, 2021, 365, and 2024/2026 LTSC, so the pattern still compiles. Changes that might affect you: 64-bit API declarations (use PtrSafe), blocked macros in downloaded files (Mark-of-the-Web), and the shift toward Office Scripts for web-first workflows.