Public Sub UpdateAllOffSpring()
Dim rsBirdLoop As DAO.Recordset
Set rsBirdLoop = CurrentDb.OpenRecordset("tbl_Birds", dbOpenDynaset)
Do Until rsBirdLoop.EOF
AddUpdateOffSpring rsBirdLoop!ID
rsBirdLoop.MoveNext
Loop
End Sub
Public Sub AddUpdateOffSpring(BirdID As Long)
Dim rsBird As DAO.Recordset
DeleteOffSpring BirdID
Set rsBird = CurrentDb.OpenRecordset("tbl_Birds", dbOpenDynaset)
AddRecursiveMaleParent rsBird, BirdID, GetRingNo(BirdID), 2
AddRecursiveFemaleParent rsBird, BirdID, GetRingNo(BirdID), 2
End Sub
Public Sub DeleteOffSpring(ByVal BirdID As Long)
Dim strSql As String
strSql = "Delete * FROM tbl_OffSpring where BirdID = " & BirdID
CurrentDb.Execute strSql
End Sub
Private Sub AddRecursiveMaleParent(rsBird As DAO.Recordset, StartingBirdID As Long, ByVal FatherRing As String, Generation As Long)
'This is a confusing name. Not adding the Father node but adding a child who has this bird as the father
On Error GoTo errLable
Dim strCriteria As String
Dim bk As String
Dim BirdID As Long
Dim BirdRingNo As String
Dim strSql As String
strCriteria = "FatherID = '" & FatherRing & "'"
rsBird.FindFirst strCriteria
'Debug.Print strCriteria
Do Until rsBird.NoMatch
' Debug.Print "match"
BirdID = rsBird.Fields("ID")
BirdRingNo = rsBird.Fields("RingNo")
bk = rsBird.Bookmark
strSql = "Insert INTO tbl_OffSpring (BirdID, OffSpringID, Generation ) VALUES (" & StartingBirdID & ", " & BirdID & ", " & Generation & ")"
'Debug.Print strSql
CurrentDb.Execute strSql
Call AddRecursiveMaleParent(rsBird, StartingBirdID, BirdRingNo, Generation + 1)
rsBird.Bookmark = bk
rsBird.FindNext strCriteria
Loop
Exit Sub
errLable:
MsgBox Err.Number & " " & Err.Description & " In addrecursiveMaleParent"
If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
Exit Sub
Else
Resume Next
End If
End Sub
Private Sub AddRecursiveFemaleParent(rsBird As DAO.Recordset, StartingBirdID As Long, ByVal MotherRing As String, Generation As Long)
'This is a confusing name. Not adding the Mother node but adding a child who has this bird as the Mother
On Error GoTo errLable
Dim strCriteria As String
Dim bk As String
Dim BirdID As Long
Dim BirdRingNo As String
Dim strSql As String
strCriteria = "MotherID = '" & MotherRing & "'"
rsBird.FindFirst strCriteria
'Debug.Print strCriteria
Do Until rsBird.NoMatch
Debug.Print "match"
BirdID = rsBird.Fields("ID")
BirdRingNo = rsBird.Fields("RingNo")
bk = rsBird.Bookmark
strSql = "Insert INTO tbl_OffSpring (BirdID, OffSpringID, Generation ) VALUES (" & StartingBirdID & ", " & BirdID & ", " & Generation & ")"
'Debug.Print strSql
CurrentDb.Execute strSql
Call AddRecursiveFemaleParent(rsBird, StartingBirdID, BirdRingNo, Generation + 1)
rsBird.Bookmark = bk
rsBird.FindNext strCriteria
Loop
Exit Sub
errLable:
MsgBox Err.Number & " " & Err.Description & " In addrecursiveFemaleParent"
If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
Exit Sub
Else
Resume Next
End If
End Sub
