troubleshooting Question

Duplicate the main record and related detail records

Avatar of schaIT
schaITFlag for United States of America asked on
Microsoft Access
6 Comments1 Solution690 ViewsLast Modified:
Hello All!  I have run into an issue cloning records in Microsoft Access.  I have modified code from Allen Browne's website.  The code clone's the main record first after prompting the end user for a new date.  That part works flawlessly.  The problem arises when I get to the detail records.  All of the information for the detail records gets cloned; however I can't get the new date inserted into the records.  It leaves it as a null value which displays as 12/30/1899 in SQL Server 2005.  I believe it must have something to do with a date delimiter, but I am not quite sure.  Any help would be greatly appreciated.

Public Function DupRec()
On Error GoTo err_handle
'Purpose:   Duplicate the main form record and related records in the subform.
'Provided by Allen Browne, November 2005

Dim lngEventID As Long, lngSetupID As Long
Dim Msg, Style, Title, Response, MyString   'Message Box
Dim datStart As Date, datEnd As Date, strEName As String
Dim strSetup As String, strMeals As String, strBvgSvc As String
Dim strEquip As String, db As DAO.Database

    
Set db = DBEngine(0)(0)

'Get dates for new record from temporary table.
datStart = DLookup("[datStart]", "zttblDupDate")
datEnd = DLookup("[datEnd]", "zttblDupDate")
strEName = Forms!fdlgDupDate!txtEName
    
'Make sure there is a record to duplicate
If Me.NewRecord Then
    'Notify the user there is no record to duplicate
    Msg = "Select a record to duplicate."
    Style = vbOKOnly + vbInformation
    Title = "No Data"
    Response = RichBox(Msg, Style, Title)
Else
    'Duplicate the main record: add to form's clone.
    With Me.RecordsetClone
        .AddNew
        !EventName = strEName
        !Client = Me.cboClient
        !Category = Me.cboCategory
        !Status = Me.cboStatus
        !Location = Me.cboLocation
        !StartDate = datStart
        !EndDate = datEnd
        !ProgramStartTime = Me.txtProgramStart
        !ProgramEndTime = Me.txtProgramEnd
        !ArrivalTime = Me.txtArrivalTime
        !SetupDate = Me.txtArrivalDate
        !SetupTime = Me.txtSetupTime
        !RegistrationTime = Me.txtRegStart
        !iMISCode = Me.txtiMISCode
        !SvcChg = Me.txtSvcChg
        !PartnerDiscount = Me.cboDiscount
        !CleaningFee = Me.txtCleaningFee
        .Update
            
        'Save the primary key value, to use as the foreign key for the related records.
        .Bookmark = .LastModified
        lngEventID = !EventID
            
        'Duplicate the related event setup records: append query.
        If Me.[Event Setup Subform].Form.RecordsetClone.RecordCount > 0 Then
            strSetup = "INSERT INTO todbEventSet ( Event, MeetingDate, MeetingLocation, RentalRate, Rate, " & vbCrLf & _
                "PrimarySetup, SecondarySetup, RegTable, ExtraChairs, ProgramStartTime, " & vbCrLf & _
                "ProgramEndTime, ExpectedPrimary, ExpectedSecondary ) " & vbCrLf & _
                "SELECT " & lngEventID & " As NewEvent, " & datStart & " As NewDate, " & vbCrLf & _
                "todbEventSet.MeetingLocation, todbEventSet.RentalRate, " & vbCrLf & _
                "todbEventSet.Rate, todbEventSet.PrimarySetup, " & vbCrLf & _
                "todbEventSet.SecondarySetup, todbEventSet.RegTable, " & vbCrLf & _
                "todbEventSet.ExtraChairs, todbEventSet.ProgramStartTime, " & vbCrLf & _
                "todbEventSet.ProgramEndTime, todbEventSet.ExpectedPrimary, " & vbCrLf & _
                "todbEventSet.ExpectedSecondary" & vbCrLf & _
                "FROM [todbEventSet] WHERE Event = " & Me.txtID & ";"
            db.Execute strSetup, dbFailOnError
        Else
            'Notify the user there is no record to duplicate
            Msg = "Select a record to duplicate."
            Style = vbOKOnly + vbInformation
            Title = "No Data"
            Response = RichBox(Msg, Style, Title)
            MsgBox "Main record duplicated, but there were no related event setup records."
        End If
                       
        'Duplicate the related meal records: append query.
        If Me.[Event Meals Subform].Form.RecordsetClone.RecordCount > 0 Then
            strMeals = "INSERT INTO [todbMeals] ( Event, MealDate, MealType, FoodSetup," & vbCrLf & _
                "SetupTime, ServingTime, Expected) " & vbCrLf & _
                "SELECT " & lngEventID & " As NewEvent, " & datStart & " As NewDate, " & vbCrLf & _
                "todbMeals.MealType, todbMeals.FoodSetup, todbMeals.SetupTime, " & vbCrLf & _
                "todbMeals.ServingTime, todbMeals.Expected" & vbCrLf & _
                "FROM [todbMeals] WHERE Event = " & Me.txtID & ";"
            db.Execute strMeals, dbFailOnError
        Else
            MsgBox "Main record duplicated, but there were no related meal records."
        End If
            
        'Duplicate the related beverage records: append query.
        If Me.[Beverage Expenses].Form.RecordsetClone.RecordCount > 0 Then
            strBvgSvc = "INSERT INTO [todbBevSvc] ( Event, ExpenseDate, Beverage, Quantity, UnitPrice ) " & vbCrLf & _
                "SELECT " & lngEventID & " As NewEvent, " & datStart & " As NewDate, " & vbCrLf & _
                "todbBevSvc.Beverage, todbBevSvc.Quantity, todbBevSvc.UnitPrice " & vbCrLf & _
                "FROM [todbBevSvc] WHERE Event = " & Me.txtID & ";"
            db.Execute strBvgSvc, dbFailOnError
        Else
            MsgBox "Main record duplicated, but there were no related beverage records."
        End If
            
        'Display the new duplicate.
        Me.Bookmark = .LastModified
    End With
End If

'Update details records using the new dates.
DoCmd.RunSQL "UPDATE todbEventSet SET [MeetingDate] = " & datStart & " WHERE [Event] = " & Me.txtID
            
'Delete temporary table
DoCmd.DeleteObject acTable, "zttblDupDate"
        
Exit_Proc:
Exit Function

err_handle:
Call ErrorLog(Err.Description, Err.Number, Me.Name, Erl, "DupRec()")
Resume Exit_Proc
End Function
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 6 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 6 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros