Option Compare Database
Option Explicit
Private Sub copyBtn_Click()
Dim strSQL As String
Dim strSQLFields As String
Dim db As DAO.Database
Dim rstS As DAO.Recordset 'Recordset Source '
Dim rstD As DAO.Recordset 'Recordset Destination '
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim lngCount As Long
Dim lngSourceID As Long
Dim lngKeyID(1) As Long 'Key for the Source and Destination - It's a Long Array with 2 elements lngKey(0) and lngKey(1) '
If Me.Dirty Then Me.Dirty = False
If Me.NewRecord Then
MsgBox "Can not copy a new record", vbCritical, " Copy Canceld"
Else
lngKeyID(0) = Me.ID.Value 'ID is the Primary Key - in this case the value of the original record '
Set db = CurrentDb
strSQL = "SELECT [Operations Header].* FROM [Operations Header] WHERE ID = " & lngKeyID(0) & ";"
Set rstS = db.OpenRecordset(strSQL, DAO.dbOpenSnapshot) 'Recordset of the Source (original) record - Snapshot as we only need to look at it's data '
strSQL = "SELECT [Operations Header].* FROM [Operations Header];"
Set rstD = db.OpenRecordset(strSQL, DAO.dbOpenDynaset, DAO.dbAppendOnly) 'Recordset for the Copy (Destination) record - Append only as we only intend to add data to it '
rstD.AddNew 'Proceed to add 1 record to the Destination recordset '
For Each fld In rstS.Fields 'Loop through every field in the Source Recordset '
If fld.Name <> "ID" Then 'Skip the ID field as it's the AutoNumber Primary Key '
rstD.Fields(fld.Name).Value = rstS.Fields(fld.Name).Value 'Copy each fields Value from the Source (rstS) to the Destination (rstD) '
End If
Next fld
lngKeyID(1) = rstD.Fields("ID").Value 'The Autonumber will automatically be assigned - before saving the record capture it here - we'll use it latter'
rstD.Update 'Now we can save the destination record '
'What follows is just cleanup '
rstD.Close
rstS.Close
Set rstD = Nothing
Set rstS = Nothing
Set db = Nothing
'Done with the cleanup.... '
'Now we copy Child records displayed in the sub form if there are any '
If Me.[Operations Details SubForm].Form.RecordsetClone.RecordCount Then
Set tdf = db.TableDefs("Operations Details")
For Each fld In tdf.Fields
If fld.Name <> "ID" Then
strSQLFields = strSQLFields & ", [" & fld.Name & "] "
End If
Next fld
strSQLFields = Mid(strSQL, 2)
strSQL = "INSERT INTO [Operations Details](ID, " & strSQLFields & ") " & _
"SELECT " & lngKeyID(1) & " AS ID, " & strSQLFields & " " & _
"FROM [Operations Details] " & _
"WHERE [ID] = " & lngKeyID(0) & ";"
CurrentDb.Execute strSQL
Else
'Note: even if child records are not copied the Parent still is.
MsgBox "Main record duplicated, but there were no related records.", vbExclamation, "No related records to copy"
End If
'Now that everything is copied move to the new (copied) record'
Me.Requery 'Requery main form to insure it sees the record added earlier - child records will be requeried once focus moves to the new record '
Me.Filter = "ID = " & lngKeyID(1)
Me.FilterOn = True
'As long as we don't exceed the field lenght we'll suffix the Operation_Number field with "-1" as the original code did. '
'Note: this doesn't guaruntee that the copy's Operation_Number is unique. Added only to be consistent with the original code. '
With Me.Operation_Number
If Len(.Value) < 48 Then .Value = .Value & "-1"
End With
Me.Dirty = False 'having changed the value of 1 field we save immediately at which point the copy is done '
End If
End Sub
Private Sub CreateNewCustomer_Click()
Application.RunCommand acCmdRecordsGoToNew
End Sub
Private Sub Find_Work_Order_Click()
If Me.FilterOn Then Me.FilterOn = False
Me.Operation_Number.SetFocus
Application.RunCommand acCmdFind
End Sub
|
