Back in 2004, I wrote an Access Archon article (Copying Records and Linked Records) that described a method for copying a record with possible linked data in another table, using an array based on form controls. This article describes a different approach, based on table fields rather than form controls, and also shows how to deal with creating a new record in another table, linked one-to-one with the main table.
The Copying Technique
In my older article, the fields to be copied were picked up from controls on a form, skipping those with “No Copy” in their Tag properties. This technique worked well for a form based on a single table, but not so well when the form is based on a query that includes two or more tables. In the case that inspired this article, a main form was based on a query that included two tables joined one-to-one, and it had a subform based on another table, also linked one-to-one to the main table.
In some cases, the one-to-one table is split off from the main table because the number of fields needed exceeds the limit for an Access table; a one-to-one join might also be needed to make some information confidential. In either case, when a record in the main table is copied, it is also necessary to make new records in the other table(s), so that is what my code does.
The sample database, Copy Record with Calc ID.accdb, has a table of employees which will be familiar to old Access hands, since it dates from early versions of the sample Northwind database. I added a table of financial data, linked to tblEmployeesCalcID one-to-one. The technique used to do the copying in this instance uses a table called tlkpNoCopyFields instead of the Tag property of a control to indicate which fields should not be copied.
The Relationships diagram for the database is shown in Figure A:
Figure B. The General Data tab of the Employees form
Figure C. The Confidential Data tab of the Employees form
VBA Code
There are several ways that the new ID field can be determined – in this sample database, the new EmployeeID value is simply 1 higher than the highest current ID (the next Access Archon will deal with the case of an AutoNumber ID field). The calculation could be more complicated, for example creating a Text ID value based on date or time elements, or it could be manually entered using an InputBox. In any case, once the current and new ID values have been determined, the procedures that do the actual copying can be called.
The first procedure is called from the Copy Record button on frmEmployeesCalcID:
1
Private Sub cmdCopyRecord_Click()
1
On Error GoTo ErrorHandler
1
1
Dim intReturn As Integer
1
Dim lngID As Long
1
Dim lngNewID As Long
1
Dim strPrompt As String
1
Dim strTitle As String
1
<strong> 'Get current ID value</strong>
1
lngID = Nz(Me![EmployeeID])
1
<strong><em><span style="color: #0000ff; font-family: Arial; font-size: small;"> 'Get new ID value (can be replaced with another calculation, as needed)</span></em></strong>
strPrompt = "Copy Employee ID " & lngID & " to a new record?"
1
intReturn = MsgBox(prompt:=strPrompt, _
1
Buttons:=vbQuestion + vbYesNo, _
1
Title:=strTitle)
1
If intReturn = vbNo Then
1
GoTo ErrorHandlerExit
1
End If
1
If CopyRecordCalcID(lngID, lngNewID) = True Then
1
strPrompt = "Copy of Employee ID " & lngID _
1
& " to Employee ID" & lngNewID & " successful"
1
Me.Requery
1
DoCmd.GoToRecord record:=acLast
1
Else
1
strPrompt = "Copy of Employee ID " & lngID _
1
& " to Project #" & lngNewID & " not successful"
1
End If
1
MsgBox prompt:=strPrompt, _
1
Buttons:=vbInformation + vbOKOnly, _
1
Title:=strTitle
1
ErrorHandlerExit:
1
Exit Sub
1
ErrorHandler:
1
MsgBox "Error No: " & Err.Number _
1
& " in " & Me.ActiveControl.Name & " procedure; " _
1
& "Description: " & Err.Description
1
Resume ErrorHandlerExit
1
End Sub
1
The two following procedures in the basUtilties module are called in turn to do the copying:
1
Public Function CopyRecordCalcID(lngID As Long, lngNewID As Long) _
1
As Boolean
1
On Error GoTo ErrorHandler
1
If CopyTableCalcID("tblEmployeesCalcID", lngID, lngNewID) _
1
= False Then
1
CopyRecordCalcID = False
1
GoTo ErrorHandlerExit
1
End If
1
If CopyTableCalcID("tblConfidentalDataCalcID", lngID, lngNewID) _
1
= False Then
1
CopyRecordCalcID = False
1
GoTo ErrorHandlerExit
1
End If
1
CopyRecordCalcID = True
1
ErrorHandlerExit:
1
Exit Function
1
ErrorHandler:
1
MsgBox "Error No: " & Err.Number _
1
& " in CopyRecordCalcID procedure; " _
1
& "Description: " & Err.Description
1
Resume ErrorHandlerExit
1
End Function
1
Public Function CopyTableCalcID(strTable As String, _
1
lngID As Long, lngNewID As Long) As Boolean
1
On Error GoTo ErrorHandler
1
Dim intCounter As Integer
1
Dim lngFieldCount As Long
1
Dim rstNoCopy As DAO.Recordset
1
Dim rstSource As DAO.Recordset
1
Dim rstTarget As DAO.Recordset
1
Dim strField As String
1
Dim strNoCopyTable As String
1
Dim strSearch As String
1
Dim varData As Variant
1
CopyTableCalcID = False
1
Debug.Print "Creating a new record in " & strTable
1
strNoCopyTable = "tlkpNoCopyFields"
1
Set rstSource = CurrentDb.OpenRecordset(strTable, dbOpenDynaset)
1
Set rstTarget = CurrentDb.OpenRecordset(strTable, dbOpenDynaset)
1
Set rstNoCopy = CurrentDb.OpenRecordset(strNoCopyTable, dbOpenDynaset)
1
lngFieldCount = rstSource.Fields.Count
1
Debug.Print lngFieldCount & " fields in " & strTable
1
strSearch = "[EmployeeID] = " & lngID
1
Debug.Print "Search string: " & strSearch
1
rstSource.FindFirst strSearch
1
<strong><em><span style="color: #0000ff; font-family: Arial; font-size: small;"> 'Iterate through table fields, copying values from each</span></em></strong>
1
<strong><em><span style="color: #0000ff; font-family: Arial; font-size: small;"> 'one that has data to a new record (except for fields that</span></em></strong>
1
<strong><em><span style="color: #0000ff; font-family: Arial; font-size: small;"> 'should not be copied)</span></em></strong>
1
rstTarget.AddNew
1
For intCounter = 0 To lngFieldCount - 1
1
strField = rstSource.Fields(intCounter).Name
1
'Debug.Print "Field name: " & strField _
1
& " (Field No. " & intCounter & ")"
1
<strong><em><span style="color: #0000ff; font-family: Arial; font-size: small;"> 'Search for field name in No Copy table</span></em></strong>
1
strSearch = "[FieldName] = " & Chr(39) & strField & Chr(39)
1
'Debug.Print "Search string: " & strSearch
1
rstNoCopy.MoveFirst
1
rstNoCopy.FindFirst strSearch
1
If strField = "EmployeeID" Then
1
rstTarget.Fields(intCounter) = lngNewID
1
ElseIf rstNoCopy.NoMatch = True Then
1
varData = rstSource.Fields(intCounter)
1
'Debug.Print "Field data: " & varData
1
If IsNull(varData) = False And varData <> "" Then
1
rstTarget.Fields(intCounter) = varData
1
Debug.Print strField & " in " & strTable & " copied"
1
End If
1
Else
1
<strong><em><span style="color: #0000ff; font-family: Arial; font-size: small;"> 'Field should not be copied</span></em></strong>
1
Debug.Print strField & " in " & strTable & " not copied"
1
End If
1
NextField:
1
Next intCounter
1
rstTarget.Update
1
CopyTableCalcID = True
1
ErrorHandlerExit:
1
Exit Function
1
ErrorHandler:
1
MsgBox "Error No: " & Err.Number _
1
& " in CopyTableWithExceptions procedure; " _
1
& "Description: " & Err.Description
1
Resume ErrorHandlerExit
1
End Function
References
The code in the sample database needs the following references (in addition to the default references):
Microsoft Word 14.0 Object Library (for SortDeclarations procedure only)
Microsoft Forms 2.0 Object Library (for SortDeclarations procedure only)
If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.
Supporting Files
The zip file containing this article, in Word 2007-2010 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch249.zip, which is the last entry in the table of Access Archon columns for Access Watch.
Document Name
Document Type
Place in
Copy Record with Calc ID.accdb
Access 2007-2010 database (can also be used in higher versions of Access)
