Question

I have the following code to loop through two tables and merge them into a new table:

Public Function MyFunction()
Dim Db As DAO.Database
Dim rst(1 To 3) As DAO.Recordset
Dim fld As DAO.Field
Dim fldname, fldtype As String
Dim PxID As Integer
Dim Iter, Counter As Integer

Set Db = CurrentDb
Set rst(1) = Db.OpenRecordset("Table1")

Call PrepTable                       ' Creates table named Test

rst(1).MoveFirst

Do While Not rst(1).EOF
    PxID = rst(1)!PersonID
    Set rst(2) = Db.OpenRecordset("SELECT * FROM Table2 WHERE PersonID=" & PxID)

    If rst(2).RecordCount > 0 Then
        rst(2).MoveLast
        'set limit to 4 records if recordcount > 4
        Iter = IIf(rst(2).RecordCount > 4, 4, rst(2).RecordCount)          
        rst(2).MoveFirst

        For Counter = 1 To Iter
            For Each fld In rst(2).Fields
                If fld.OrdinalPosition = 0 Then
                    fldname = "PersonID"
                Else
                    fldname = fld.Name & Trim(Str(Counter))
                End If

                If Not IsNull(fld.Value) Then
                    Set rst(3) = Db.OpenRecordset("Test")
                    'create new record on Test only if on new record on Table2
                    If (fldname = "PersonID" And Counter = 1) Then       
                        rst(3).AddNew
                    Else
                        rst(3).Move 0
                        rst(3).Edit
                    End If
                    rst(3)(fldname).Value = fld.Value
                    rst(3).Update
                    rst(3).Bookmark = rst(3).LastModified                     'not sure about this at all
                End If
            Next

        rst(2).MoveNext
        Next
        rst(3).Close
    End If

    rst(2).Close
    Set rst(2) = Nothing
    Set rst(3) = Nothing
    rst(1).MoveNext
Loop
rst(1).Close
Set rst(1) = Nothing

Debug.Print "Done."
Db.TableDefs.Refresh
DoCmd.OpenTable "Test", acViewNormal

End Function

Table1 contains 10 records. This function correctly creates 10 records on the Test table. However, only the first record is being updated (causing new data to overwrite the old). The last 9 records are blank save for the autonumber field of table Test and the PersonID field.

The basic question is: How do I move to the next row for the edit and update?

Was it helpful?

Solution

What you are trying to accomplish is really not entirely clear.
From what I understand, you are trying to transpose the first 4 records of Table2 into columns in table Temp.

Here, you are opening your rs(3) every for every field you loop through, but you never close it within that loop; you close it outside of the loop, at a level where it may not even be open...

So, first thing is to move that Set rst(3) = Db.OpenRecordset("Test") outside of all the loops.

Then it's not clear why you are doing with the rst(3).Move 0 and the rst(3).Bookmark = rst(3).LastModified.
Once you have added a new record, you do not need to call Edit on it again, or move around records and bookmakrs. All you need to do is make sure you call rst(3).Update after you copied all the field data.

Public Function MyFunction()
Dim Db As DAO.Database
Dim rst(1 To 3) As DAO.Recordset
Dim fld As DAO.Field
Dim fldname, fldtype As String
Dim PxID As Integer
Dim Iter, Counter As Integer

Set Db = CurrentDb
Set rst(1) = Db.OpenRecordset("Table1")

Call PrepTable                       ' Creates table named Test

rst(1).MoveFirst
Set rst(3) = Db.OpenRecordset("Test")
Do While Not rst(1).EOF
    PxID = rst(1)!PersonID
    Set rst(2) = Db.OpenRecordset("SELECT * FROM Table2 WHERE PersonID=" & PxID)

    If rst(2).RecordCount > 0 Then
        rst(2).MoveLast
        'set limit to 4 records if recordcount > 4
        Iter = IIf(rst(2).RecordCount > 4, 4, rst(2).RecordCount)          
        rst(2).MoveFirst

        For Counter = 1 To Iter
            For Each fld In rst(2).Fields
                If fld.OrdinalPosition = 0 Then
                    fldname = "PersonID"
                Else
                    fldname = fld.Name & Trim(Str(Counter))
                End If

                If Not IsNull(fld.Value) Then
                    'create new record on Test only if on new record on Table2
                    If (fldname = "PersonID" And Counter = 1) Then       
                        rst(3).AddNew
                    End If
                    rst(3)(fldname).Value = fld.Value
                End If
            Next
            If rs(3).EditMode <> dbEditNone Then
                rst(3).Update
            End If
            rst(2).MoveNext
        Next
    End If
    rst(2).Close
    Set rst(2) = Nothing
    rst(1).MoveNext
Loop
rst(3).Close
rst(1).Close
Set rst(3) = Nothing
Set rst(1) = Nothing

Debug.Print "Done."
Db.TableDefs.Refresh
DoCmd.OpenTable "Test", acViewNormal

End Function

I'm not saying this will work, and you could certainly clean up the logic in that code, but this should make it a bit better already.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top