What is the best way to duplicate a record?

[J]

I need to be able to duplicate a record in VB and then return the
primary key so I can make changes to it. What is the best method for
doing this?

~J

 

[J]

I almost forgot:
This is not being called from the form with the active record, so a
straight up:
DoCmd.SetWarnings False
RunCommand acCmdSelectRecord
RunCommand acCmdCopy
RunCommand acCmdPasteAppend
DoCmd.SetWarnings True
doesn't help me.

 

[Guest]

If it is not the current record of the form, how do you know which record you
want to duplicate? And, how do you plan to modify the primary key field?
The basics will probably need to be something like:

Dim rst As Recordset

Set rst = CurrentDb.OpenRecordset("SomeTable", dbOpenDynaset)

rst.FindFirst "[PrimaryKeyField] = '" & SomeVauleFromSomeWhere & "'"
If Not rst.NoMatch Then
'put all the field values in varialbes
rst.Addnew
'Change the primary key variable and put all the varialbes in the
new record
rst.Update
End If

 

[Guest]

You could use a function along the following lines. Just paste it into a
standard module in your database and call it, passing into the function the
table name, key column name, key value of the record to be copied and a list
of the columns to be copied into the new record. The key can be an
autonumber or a straightforward long integer number data type. So to copy a
Contacts record for Contact ID 42 you might call it like so:

Dim lngNewID

lngNewID = CopyRecord ("Contacts","ContactID",
42,"FirstName","LastName", "Address")

If it succeeds it will return the new ContactID value, if not it will return
zero. Here's the function:

Public Function CopyRecord(strTable As String, _
strKey As String, _
lngKeyVal As Long, _
ParamArray aColumns() As Variant) As Long

Dim cmd As ADODB.Command
Dim strSQL As String
Dim strColumnList As String
Dim lngLastKey As Long
Dim varColumn As Variant

' does record to be copied exist?
If IsNull(DLookup(strKey, strTable, strKey & "=" & lngKeyVal)) Then
MsgBox "Record not found.", vbInformation, "Warning"
Else
lngLastKey = DMax(strKey, strTable)

Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandType = adCmdText

' build column list
For Each varColumn In aColumns
strColumnList = strColumnList & "," & varColumn
Next varColumn
' remove leading comma
strColumnList = Mid(strColumnList, 2)

' insert new row into table
strSQL = "INSERT INTO " & strTable & "(" & _
strKey & "," & strColumnList & ")" & _
" SELECT " & lngLastKey + 1 & "," & strColumnList & _
" FROM " & strTable & " WHERE " & strKey & " = " & lngKeyVal

cmd.CommandText = strSQL
cmd.Execute

Set cmd = Nothing

' return new record's key value
CopyRecord = lngLastKey + 1
End If

End Function

Ken Sheridan
Stafford, England