Generic Function to Copy Record changing value of Foreign Key

Need a generic function that can be used to append a copy of the current record in a recordset.  All fields will be given the same values as the source record except for the foreign or parent key value.  The table also has an autonumber field, so this field cannot be copied.

hertzgordmanAsked:
Who is Participating?
 
hertzgordmanAuthor Commented:
Thanks, but don't see what I need there.

I need to do this from code, specified a new parent key.

This is the code I have worked out so far, but I am not sure if it is the best approach:

Public Function CopyRecord(SourceTable As String, KeyField As Variant, ParentKeyField As String, ParentKeyFilter As Long, ParentKeyNewValue As Variant)
                                       
  On Error GoTo err_CopyRecord


    Dim MyDb As Database
    Dim MySql As String
   
    Dim rsSource As Recordset
    Dim rsTarget As Recordset
    Dim fooBar As Variant
    Dim FieldNo As Integer
    Dim FieldName As String
    Dim SourceFieldValue As Variant
   
    Dim NoFields As Integer
    Dim i As Integer
   
    Set MyDb = CurrentDb
   
    'Source
    MySql = "Select " & SourceTable & ".*" _
             & " FROM " & SourceTable _
             & " WHERE (((" & SourceTable & "." & ParentKeyField & ")=" & CStr(ParentKeyFilter) & "));"
             Debug.Print MySql
             
           
    Set rsSource = MyDb.OpenRecordset(MySql)
    Set rsTarget = MyDb.OpenRecordset(MySql)
   
    If rsSource.EOF Then
       
        'MsgBox ("No data to copy")
       
        rsSource.Close
        rsTarget.Close
        MyDb.Close
       
        Exit Function
   
       
    End If
   
   
    rsTarget.AddNew
   
        NoFields = rsTarget.Fields.Count
        For i = 0 To (NoFields - 1)
       
            FieldNo = i
            FieldName = rsTarget(i).Name
            SourceFieldValue = rsSource(i).Value
           
           
            If FieldName <> KeyField Or KeyField = "NA" Then  'Do not update key field
           
                If FieldName = ParentKeyField Then
                   
                    rsTarget(i).Value = ParentKeyNewValue
               
                Else
               
                    rsTarget(i).Value = SourceFieldValue
               
                End If
           
           
            End If
           
        Next i
       
                 
             
    rsTarget.Update
                   
       
    rsSource.Close
    rsTarget.Close
    MyDb.Close
   
    Exit Function
   
err_CopyRecord:
   
    If Err.Number = 3021 Then
        MsgBox ("No current record")
        Resume Next
    ElseIf Err.Number = 3022 Then
        Resume Next
    ElseIf Err.Number > 0 Then
       
        MsgBox (Err.Number & " " & Err.Description)
   
        Exit Function
    End If
   


End Function

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.