Solved

Generic Function to Copy Record changing value of Foreign Key

Posted on 2004-09-08
2
181 Views
Last Modified: 2012-08-14
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.

0
Comment
Question by:hertzgordman
2 Comments
 
LVL 4

Accepted Solution

by:
Excalibur_Software earned 250 total points
ID: 12012950
0
 

Author Comment

by:hertzgordman
ID: 12017194
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

Featured Post

Active Directory Webinar

We all know we need to protect and secure our privileges, but where to start? Join Experts Exchange and ManageEngine on Tuesday, April 11, 2017 10:00 AM PDT to learn how to track and secure privileged users in Active Directory.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question