“Nested” copy and paste facility for related sub-records and sub-sub-records (1 Viewer)

[Big Pat]

I posted about this problem some months ago and was tactfully invited to go and learn some code, because what I was asking for was not straightforward. I have VERY basic knowledge of VBA, so this was a little disappointing at the time, but in hindsight it was a great idea and I *have* learned quite a bit. No-one is more amazed then me that I’ve made step 1 of this work, but I’ve been going round this for about a week now and I need help with step 2 (and step 3, though I think that will be almost a duplicate of step 2). I think I’ve got the code “more or less” right, but I suspect I’m doing a couple of things in the wrong order.

My database has tblHouses, tblRooms and tblItems. Each house has many rooms and each room has many items. Relationships are shown in the attached jpeg. I have a form that lists records from tblHouses in continuous view and each record has a “Copy” button.

When this is clicked, I want three things to happen:
1. Add a new record to tblHouses, with all the field-values from the copied record written to the new one.
2. Add the right number of records to tblRooms, copy all the field-values from the relevant records (related to the copied HOUSE) and write those values to the new records. Assign the foreign keys to relate these new ROOMS to the new HOUSE.
3. Add the right number of records to tblItems, copy all the field-values from the relevant records (related to the copied ROOMS) and write those values to the new records. Assign the foreign keys to relate these new ITEMS to the new ROOMS.

… and then open the new records (I can do that bit!!) using a different form that shows records in single view, with a sub-form and a sub-sub-form

It works fine down to the dotted line. If I comment out the section below that, down to the next dotted line, then all the fields at step 1 are successfully copied and pasted. But if I try to run this next section too, then I get the “No current record” error. When I look in the tables, it *has* created the new HOUSE record at step 1 and it has created the *first* ROOM record at step 2, but it hasn't related it, by assigning the foreign key. In fact the RoomNo filed is blank

I have clicked Compile in the Debug menu, but if you need me to debug in any greater detail, then you'll need to explain EXACTLY what I have to do about breakpoints etc. I've heard the terminology but I'm a complete thicko at that part !!

I *think* I need to nest step 2 inside step 1 (and step 3 inside step 2) but I have tried various things and I’m not getting anywhere. Can anyone advise how I should fix this?

Pat.

Private Sub cmdCopy_Click()

'   ***********************************************************************************************************************
'   When the User clicks Copy a new "HOUSE" must be created and the values of all the fields in that table must be
'   "copied and pasted" to the new record.  Then: the correct number of new "ROOM" and "ITEM" records must be created.
'   Again, the values must be copied and pasted to the new records, but with the foreign keys of the new HOUSE and the
'   new ROOMS as appropriate. So, all new records must be correctly related.  Finally the new records should be displayed
'   in frmHouse and its subforms.
'   ***********************************************************************************************************************

On Error GoTo error_handling

Dim rsHouse As Object, rsRoom As Object, rsItem As Object
Dim oldHouse As Long, newHouse As Long
Dim oldRoom As Long, newRoom As Long
Dim oldItem As Long, newItem As Long
Dim countRooms As Integer, countItems As Integer

Dim SQL_1 As String          ' this is used below to specify the record for the "oldhouse"
Dim SQL_2 As String          ' used at ROOM level
Dim SQL_3 As String          ' used at ITEM level

'Define variables for every field that will be copied.  For convenience
'the variables are all named "t" (for temp) followed by the actual fieldname

'General
Dim tDoorType As String
Dim tDoorCondition As String
Dim tRoofType As String
Dim tRoofCondition As String
Dim tChimneyType As String
Dim tChimneyCondition As String
'Kitchen
Dim tKCeilingColour As String
Dim tKCeilingCondition As String
Dim tKWallsColour As String
Dim tKWallsCondition As String
Dim tKDoorsColour As String
Dim tKDoorsCondition As String
Dim tOvenDescription As String
Dim tOvenCondition As String
Dim tDishwasherDescription As String
Dim tDishwasherCondition As String
Dim tWasherDescription As String
Dim tWasherCondition As String
'Bathroom
Dim tBCeilingColour As String
Dim tBCeilingCondition As String
Dim tBWallsColour As String
Dim tBWallsCondition As String
Dim tBDoorsColour As String
Dim tBDoorsCondition As String
Dim tBathDescription As String
Dim tBathCondition As String
Dim tShowerDescription As String
Dim tShowerCondition As String
Dim tWCDescription As String
Dim tWCCondition As String
'Rooms
Dim tRoomName As String
Dim tCeilingColour As String
Dim tCeilingCondition As String
Dim tWallsColour As String
Dim tWallsCondition As String
Dim tDoorsColour As String
Dim tDoorsCondition As String


oldHouse = Me.HouseID
SQL_1 = "Select * from tblHouses where HouseID = " & oldHouse     'Get all fields related to the "source" house

Set rsHouse = CurrentDb.OpenRecordset(SQL_1)

With rsHouse
'   ***COPY***
    'General
    If Not IsNull(rsHouse.DoorType) Then tDoorType = rsHouse.DoorType
    If Not IsNull(rsHouse.DoorCondition) Then tDoorCondition = rsHouse.DoorCondition
    If Not IsNull(rsHouse.RoofType) Then tRoofType = rsHouse.RoofType
    If Not IsNull(rsHouse.RoofCondition) Then tRoofCondition = rsHouse.RoofCondition
    If Not IsNull(rsHouse.ChimneyType) Then tChimneyType = rsHouse.ChimneyType
    If Not IsNull(rsHouse.ChimneyCondition) Then tChimneyCondition = rsHouse.ChimneyCondition
    'Kitchen
    If Not IsNull(rsHouse.KCeilingColour) Then tKCeilingColour = rsHouse.KCeilingColour
    If Not IsNull(rsHouse.KCeilingCondition) Then tKCeilingCondition = rsHouse.KCeilingCondition
    If Not IsNull(rsHouse.KWallsColour) Then tKWallsColour = rsHouse.KWallsColour
    If Not IsNull(rsHouse.KWallsCondition) Then tKWallsCondition = rsHouse.KWallsCondition
    If Not IsNull(rsHouse.KDoorsColour) Then tKDoorsColour = rsHouse.KDoorsColour
    If Not IsNull(rsHouse.KDoorsCondition) Then tKDoorsCondition = rsHouse.KDoorsCondition
    If Not IsNull(rsHouse.OvenDescription) Then tOvenDescription = rsHouse.OvenDescription
    If Not IsNull(rsHouse.OvenCondition) Then tOvenCondition = rsHouse.OvenCondition
    If Not IsNull(rsHouse.DishwasherDescription) Then tDishwasherDescription = rsHouse.DishwasherDescription
    If Not IsNull(rsHouse.DishwasherCondition) Then tDishwasherCondition = rsHouse.DishwasherCondition
    If Not IsNull(rsHouse.WasherDescription) Then tWasherDescription = rsHouse.WasherDescription
    If Not IsNull(rsHouse.WasherCondition) Then tWasherCondition = rsHouse.WasherCondition
    'Bathroom
    If Not IsNull(rsHouse.BCeilingColour) Then tBCeilingColour = rsHouse.BCeilingColour
    If Not IsNull(rsHouse.BCeilingCondition) Then tBCeilingCondition = rsHouse.BCeilingCondition
    If Not IsNull(rsHouse.BWallsColour) Then tBWallsColour = rsHouse.BWallsColour
    If Not IsNull(rsHouse.BWallsCondition) Then tBWallsCondition = rsHouse.BWallsCondition
    If Not IsNull(rsHouse.BDoorsColour) Then tBDoorsColour = rsHouse.BDoorsColour
    If Not IsNull(rsHouse.BDoorsCondition) Then tBDoorsCondition = rsHouse.BDoorsCondition
    If Not IsNull(rsHouse.BathDescription) Then tBathDescription = rsHouse.BathDescription
    If Not IsNull(rsHouse.BathCondition) Then tBathCondition = rsHouse.BathCondition
    If Not IsNull(rsHouse.ShowerDescription) Then tShowerDescription = rsHouse.ShowerDescription
    If Not IsNull(rsHouse.ShowerCondition) Then tShowerCondition = rsHouse.ShowerCondition
    If Not IsNull(rsHouse.WCDescription) Then tWCDescription = rsHouse.WCDescription
    If Not IsNull(rsHouse.WCCondition) Then tWCCondition = rsHouse.WCCondition
    
    .AddNew
    
    ![Address1] = "Copy of " & Me.Address1                      'User can change the address, when the form opens
    
'   *** PASTE ***
    'General
    ![DoorType] = tDoorType
    ![DoorCondition] = tDoorCondition
    ![RoofType] = tRoofType
    ![RoofCondition] = tRoofCondition
    ![ChimneyType] = tChimneyType
    ![ChimneyCondition] = tChimneyCondition
    'Kitchen
    ![KCeilingColour] = tKCeilingColour
    ![KCeilingCondition] = tKCeilingCondition
    ![KWallsColour] = tKWallsColour
    ![KWallsCondition] = tKWallsCondition
    ![KDoorsColour] = tKDoorsColour
    ![KDoorsCondition] = tKDoorsCondition
    ![OvenDescription] = tOvenDescription
    ![OvenCondition] = tOvenCondition
    ![DishwasherDescription] = tDishwasherDescription
    ![DishwasherCondition] = tDishwasherCondition
    ![WasherDescription] = tWasherDescription
    ![WasherCondition] = tWasherCondition
    'Bathroom
    ![BCeilingColour] = tBCeilingColour
    ![BCeilingCondition] = tBCeilingCondition
    ![BWallsColour] = tBWallsColour
    ![BWallsCondition] = tBWallsCondition
    ![BDoorsColour] = tBDoorsColour
    ![BDoorsCondition] = tBDoorsCondition
    ![BathDescription] = tBathDescription
    ![BathCondition] = tBathCondition
    ![ShowerDescription] = tShowerDescription
    ![ShowerCondition] = tShowerCondition
    ![WCDescription] = tWCDescription
    ![WCCondition] = tWCCondition
    
    
    .Update
    .Bookmark = .LastModified
    newHouse = rsHouse.HouseID                     'Store the ID of the newly created HOUSE record
End With


SQL_2 = "select tblRooms.* from tblRooms where HouseNo = " & oldHouse    'Get all fields from tblRooms related to the "source" house  '
Set rsRoom = CurrentDb.OpenRecordset(SQL_2)                                                                                           '
rsRoom.MoveLast
rsRoom.MoveFirst                                                                                                                      '

'----------------------------------------------------------------------------------------------------------------------------------------
With rsRoom                                                                                                           ' Should this

For countRooms = 1 To rsRoom.RecordCount
    oldRoom = rsRoom.RoomID                                                                                           ' whole section
     
    '  ***Copy***                                                                                                       be nested inside
    If Not IsNull(rsRoom.RoomName) Then tRoomName = rsRoom.RoomName
    If Not IsNull(rsRoom.CeilingColour) Then tCeilingColour = rsRoom.CeilingColour                                    ' the previous
    If Not IsNull(rsRoom.CeilingCondition) Then tCeilingCondition = rsRoom.CeilingCondition
    If Not IsNull(rsRoom.WallsColour) Then tWallsColour = rsRoom.WallsColour                                          ' With/End with?
    If Not IsNull(rsRoom.WallsCondition) Then tWallsCondition = rsRoom.WallsCondition
    If Not IsNull(rsRoom.DoorsColour) Then tDoorsColour = rsRoom.DoorsColour
    If Not IsNull(rsRoom.DoorsCondition) Then tDoorsCondition = rsRoom.DoorsCondition                                 'If so, where exactly???
        
   .AddNew
    ![HouseNo] = currenthouse                  'This sets the foreign key for the tblRooms record
    
    '  ***PASTE***
    ![RoomName] = tRoomName                                                                                            ' And where
    ![CeilingColour] = tCeilingColourt
    ![CeilingCondition] = tCeilingCondition                                                                            ' should I put
    ![WallsColour] = tWallsColour
    ![WallsCondition] = tWallsCondition                                                                                ' a new section
    ![DoorsColour] = tDoorsColour
    ![DoorsCondition] = tDoorsCondition                                                                                ' for handling
                                                                                                                                        
    .Update                                                                                                            ' tblItems
    .Bookmark = .LastModified
    newRoom = rsRoom.RoomID                                                                                            ' in the
    rsRoom.MoveNext
Next countRooms                                                                                                        ' same way?

End With
'----------------------------------------------------------------------------------------------------------------------------------------

rsRoom.Close
Set rsRoom = Nothing


rsHouse.Close
Set rsHouse = Nothing

stDocName = "frmHouse"
stLinkCriteria = "[HouseID]=" & newHouse

DoCmd.OpenForm stDocName, , , stLinkCriteria

exithere:
Exit Sub

error_handling:
MsgBox Err.Description
Resume exithere

End Sub

I can zip and post a copy of the database if that would help. Thanks!

 

[Big Pat]

Skip it...I figured it out. Go me!