Solved Trouble looping through records (1 Viewer)

Kayleigh

Member
Local time
Today, 11:17
Joined
Sep 24, 2020
Messages
706
Wrote code to copy a record and its related records by looping through all linked subtables. This ALMOST works fine but the loop is slightly incorrect - it copies one record on the second level (jtblSessionWeekday) and then all records on the third level (jtblSessionDayTimes).
(Database enclosed - try click 'copy session for new term' and observe results on timings subform.)

1. Can anyone suggest how I can tweak the loop to correct this?
2. How do I add a fourth level (jtblSessionWeekdayStudent) as an append query?

Many thanks for all your help!
 

Attachments

  • SessionTest12.accdb
    1.3 MB · Views: 436

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:17
Joined
May 21, 2018
Messages
8,463
This is kind of tough. I believe I got it to work, but not as clean As I would like. Use the CopySessionAndChildren procedure.
Code:
Public Sub CopySession(SessionID As Long)
  Dim strSql As String
  strSql = "INSERT INTO tblSession ( fldPrivateLesson, fldTermID, fldLessonName, fldStaffID, fldClassID, fldSplitID, fldRoomID, fldStudentID, fldSubjectID, fldNote, fldAuxiliaryStaffID, fldAuxiliaryStaff2ID ) " & _
  "SELECT fldPrivateLesson, fldTermID, fldLessonName, fldStaffID, fldClassID, fldSplitID, fldRoomID, fldStudentID, fldSubjectID, fldNote, fldAuxiliaryStaffID, fldAuxiliaryStaff2ID " & _
  "FROM tblSession " & _
  "WHERE fldSessionID = " & SessionID
  CurrentDb.Execute strSql
End Sub
Public Function GetlatestSession() As Long
  GetlatestSession = DMax("fldSessionID", "tblSession")
End Function
Public Sub CopySessionWeekDays(NewSessionID, OldSessionID)
  Dim strSql As String
  strSql = "INSERT INTO jtblSessionWeekday ( fldSessionID, fldWeekdayID ) " & _
  "SELECT " & NewSessionID & ", jtblSessionWeekday.fldWeekdayID " & _
  "FROM jtblSessionWeekday " & _
  "WHERE jtblSessionWeekday.fldSessionID = " & OldSessionID
  Debug.Print strSql
  CurrentDb.Execute strSql
End Sub
Public Sub CopySessionTimes(NewSessionID As Long, OldSessionID As Long)
  Dim strSql As String
  Dim rsOld As DAO.Recordset
  Dim rsNew As DAO.Recordset
  Dim NewDayID As Long
  'These are the original days and times
  strSql = "SELECT jtblSessionWeekday.fldWeekdayID, jtblSessionDayTimes.fldStart, jtblSessionDayTimes.fldEnd, jtblSessionWeekday.fldSessionID, jtblSessionDayTimes.fldSessionDayID " & _
           "FROM jtblSessionWeekday INNER JOIN jtblSessionDayTimes ON jtblSessionWeekday.fldSessionDayID = jtblSessionDayTimes.fldSessionDayID " & _
           "WHERE jtblSessionWeekday.fldSessionID = " & OldSessionID
  Set rsOld = CurrentDb.OpenRecordset(strSql)
  strSql = "select * from jtblSessionDayTimes where true = false"
  Set rsNew = CurrentDb.OpenRecordset(strSql)
  Do While Not rsOld.EOF
    Debug.Print rsOld!fldWeekdayID
    'Need to get the new day id for the same day of the week
    NewDayID = GetNewDayID(NewSessionID, rsOld!fldWeekdayID)
    rsNew.AddNew
      rsNew!fldSessionDayID = NewDayID
      rsNew!fldStart = rsOld!fldStart
      rsNew!fldEnd = rsOld!fldEnd
    rsNew.Update
   
    rsOld.MoveNext
  Loop
End Sub
Public Function GetNewDayID(NewSessionID As Long, WeekdayID As Long)
  GetNewDayID = DLookup("fldSessionDayID", "jtblSessionWeekday", "fldSessionID = " & NewSessionID & " AND fldWeekdayID = " & WeekdayID)
End Function

Public Sub CopySessionAndChildren(OldSessionID As Long)
  Dim NewSessionID As Long
  CopySession OldSessionID
  NewSessionID = GetlatestSession
  CopySessionWeekDays NewSessionID, OldSessionID
  CopySessionTimes NewSessionID, OldSessionID
End Sub
Public Sub Test()
  CopySessionAndChildren 380
End Sub
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:17
Joined
May 21, 2018
Messages
8,463
I see I forgot the student level. I will look later.
 

Kayleigh

Member
Local time
Today, 11:17
Joined
Sep 24, 2020
Messages
706
This code looks great and works fine so far! (Still need the related records from jtblStudentSession and jtblSessionWeekdayStudent...)

Just wondering was my code so terrible?? - was about 5 hours of work! (looks like you rewrote lots..)
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:17
Joined
May 21, 2018
Messages
8,463
Just wondering was my code so terrible??
In truth I did not even look at it, so it may be great. Here is why.
1. I do this so much that I have my preferred way to approach it
2. If you have ever read someone else's multiple looping query, you would know that it is far harder to decipher and try to debug than to build your own. This took me about 20 minutes.
3. I write code in small bites instead of trying to swallow the elephant whole. You will see each procedure or function does one and only one thing
4. I write all my code so that it can be easily debugged. I can test each of those procedures individually without going to the form. In the immediate window I can pass each function literal values and they will work.
5. I try to write all my code as flexible reusable black boxes. You do not need to understand how it works, but need to understand the inputs and outputs so that it can be reused easily.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:17
Joined
May 21, 2018
Messages
8,463
Code:
  Dim strSql As String
  strSql = "INSERT INTO tblSession ( fldPrivateLesson, fldTermID, fldLessonName, fldStaffID, fldClassID, fldSplitID, fldRoomID, fldStudentID, fldSubjectID, fldNote, fldAuxiliaryStaffID, fldAuxiliaryStaff2ID ) " & _
  "SELECT fldPrivateLesson, fldTermID, fldLessonName, fldStaffID, fldClassID, fldSplitID, fldRoomID, fldStudentID, fldSubjectID, fldNote, fldAuxiliaryStaffID, fldAuxiliaryStaff2ID " & _
  "FROM tblSession " & _
  "WHERE fldSessionID = " & SessionID
  CurrentDb.Execute strSql
End Sub
Public Function GetlatestSession() As Long
  GetlatestSession = DMax("fldSessionID", "tblSession")
End Function
Public Sub CopySessionWeekDays(NewSessionID, OldSessionID)
  Dim strSql As String
  strSql = "INSERT INTO jtblSessionWeekday ( fldSessionID, fldWeekdayID ) " & _
  "SELECT " & NewSessionID & ", jtblSessionWeekday.fldWeekdayID " & _
  "FROM jtblSessionWeekday " & _
  "WHERE jtblSessionWeekday.fldSessionID = " & OldSessionID
  Debug.Print strSql
  CurrentDb.Execute strSql
End Sub
Public Sub CopySessionTimes(NewSessionID As Long, OldSessionID As Long)
  Dim strSql As String
  Dim rsOld As DAO.Recordset
  Dim rsNew As DAO.Recordset
  Dim NewDayID As Long
  Dim OldSessionDayTime As Long
  Dim NewSessionDayTime As Long
  'These are the original days and times
  strSql = "SELECT jtblSessionWeekday.fldWeekdayID, jtblSessionDayTimes.fldStart, jtblSessionDayTimes.fldEnd, jtblSessionWeekday.fldSessionID, jtblSessionDayTimes.fldSessionDayID, jtblSessionDayTimes.fldSessionDayTimesID " & _
           "FROM jtblSessionWeekday INNER JOIN jtblSessionDayTimes ON jtblSessionWeekday.fldSessionDayID = jtblSessionDayTimes.fldSessionDayID " & _
           "WHERE jtblSessionWeekday.fldSessionID = " & OldSessionID
  Set rsOld = CurrentDb.OpenRecordset(strSql)
  strSql = "select * from jtblSessionDayTimes where true = false"
  Set rsNew = CurrentDb.OpenRecordset(strSql)
  Do While Not rsOld.EOF
    Debug.Print rsOld!fldWeekdayID
    'Need to get the new day id for the same day of the week
    NewDayID = GetNewDayID(NewSessionID, rsOld!fldWeekdayID)
    rsNew.AddNew
      rsNew!fldSessionDayID = NewDayID
      rsNew!fldStart = rsOld!fldStart
      rsNew!fldEnd = rsOld!fldEnd
    rsNew.Update
      'Get the old and new sessiondaytimeid
      OldSessionDayTime = rsOld!fldSessionDayTimesID
      NewSessionDayTime = DMax("fldSessionDayTimesID", "jtblSessionDayTimes")
      CopyTimeStudents OldSessionDayTime, NewSessionDayTime
    rsOld.MoveNext
  Loop
End Sub
Public Sub CopyTimeStudents(OldSessionDayTime As Long, NewSessionDayTime As Long)
  Dim strSql As String
  Dim rsOld As DAO.Recordset
  Dim rsNew As DAO.Recordset
  strSql = "SELECT jtblSessionWkdayStudent.fldSessionDayTimesID, jtblSessionWkdayStudent.fldStudentID " & _
           "FROM jtblSessionWkdayStudent " & _
           "WHERE jtblSessionWkdayStudent.fldSessionDayTimesID = " & OldSessionDayTime
  Debug.Print strSql
  Set rsOld = CurrentDb.OpenRecordset(strSql)
  Do While Not rsOld.EOF
    strSql = "INSERT INTO jtblSessionWkdayStudent ( fldSessionDayTimesID, fldStudentID ) " & _
    "values(" & NewSessionDayTime & ", " & rsOld!fldStudentID & ")"
    Debug.Print strSql
     CurrentDb.Execute strSql
    rsOld.MoveNext
  Loop
 

End Sub
Public Function GetNewDayID(NewSessionID As Long, WeekdayID As Long)
  GetNewDayID = DLookup("fldSessionDayID", "jtblSessionWeekday", "fldSessionID = " & NewSessionID & " AND fldWeekdayID = " & WeekdayID)
End Function

Public Sub CopySessionAndChildren(OldSessionID As Long)
  Dim NewSessionID As Long
  CopySession OldSessionID
  NewSessionID = GetlatestSession
  CopySessionWeekDays NewSessionID, OldSessionID
  CopySessionTimes NewSessionID, OldSessionID
End Sub

I think this works, but this is the kind of code that makes your head spin. 4 Level deep junction table updateo_O You will have to check. The only way this even has a chance of working is because your db is very well designed.
1. Your naming convention is excellent
2. Your tables are extremely well structured
3. Your primary and foreign keys are autonumbers

This would have been impossible with non numeric keys or bad names.
 

Kayleigh

Member
Local time
Today, 11:17
Joined
Sep 24, 2020
Messages
706
Hey thanks for that:)
I'm actually working closely with an expert programmer (member of AWF!) to design this system so can't really take all the credit for the fantastic design. Though I can say that we thought it out together!

I have a form displaying a summary list of all sessions. Would like to write a function to iterate through list to copy each session. Would this code do it? How would I loop through?

Code:
DoCmd.OpenForm "DEFrmSessions", , , "fldSessionID = " & Me.fldSessionID
Forms!DEFrmSessions.CopySessionAndChildren Me.fldSessionID
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:17
Joined
May 21, 2018
Messages
8,463
This is untested just freehand typed, but something like

Code:
Dim rs as dao.recordset
dim SessionID as long
set RS=me.recordsetclone  'get the sessions to copy


Do while not rs.eof
  sessionID = rs!fldSessionID   'I think this is the correct name
  CopySessionAndChildren SessionID
  rs.movenext
Loop

Out of curiosity what is the purpose of copying all sessions?
 

Kayleigh

Member
Local time
Today, 11:17
Joined
Sep 24, 2020
Messages
706
Wow can't believe that works so well:)

So the only bit you missed in your original code was (fldTerm + 1) ie. all sessions are duplicated for next term and then we use as foundation for new schedule.

Great to work with you @MajP !
 

Users who are viewing this thread

Top Bottom