THEO TODMAN’S WEBSITE CODE PAGES


This Page provides a jumping-off point for the VBA Code that generates my Website.

Table of Code Documentation Location 55 (5 items)

Functor_Indented_ListFunctor_Indented_List_DevelopmentFunctor_Indented_List_SavedUpdate_Live_Notes_Functor
Update_Thesis_Chapter_RLs...

To access information, click on one of the links in the table above.

Go to top of page



Source Code of: Functor_Indented_List
Procedure Type: Public Function
Module: Testing
Lines of Code: 193
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_Indented_List(rs As Recordset, strValue, Optional Recursion As Boolean)
0002Dim strValue_Local As String
0003Dim Recursion_Local As Boolean
0004Dim strCell As String
0005Dim Testing As Boolean
0006Dim i As Integer
0007Dim j As Integer
0008Dim iLevel As Integer
0009Dim iLevel_Saved As Integer
0010Dim iLevel_Next As Integer
0011Dim iNote_ID As Integer
0012Dim strCaption As String
0013Dim strFootnote As String
0014Dim Categories(4) As String
0015Dim Active_Levels(4) As Boolean
0016Dim Concat_Categories As String
0017Dim Concat_Categories_Saved As String
0018Dim No_Print As String
0019Dim strNote_Title As String
0020Dim strPrint_Row As String
0021Dim Exclusion As Boolean
0022Dim strReason_Excluded As String
0023Dim irs_Count As Integer
0024Dim boolCategory_Header_Done As Boolean
0025Dim strMarker As String
0026Testing = False
0027j = 1
0028rs.MoveLast
0029irs_Count = rs.RecordCount
0030rs.MoveFirst
0031If IsMissing(Recursion) Then
0032 Recursion_Local = False
0033Else
0034 Recursion_Local = Recursion
0035 strCell = ""
0036End If
0037If Recursion_Local = True Then
0038 'Stop
0039End If
0040strValue_Local = strValue
0041Concat_Categories = ""
0042Concat_Categories_Saved = ""
0043strPrint_Row = "|II|"
0044Active_Levels(1) = True
0045For i = 2 To 4
0046 Active_Levels(i) = False
0047Next i
0048strValue_Local = ""
0049Do Until rs.EOF
0050 If Testing = True Then
0051 For i = 0 To rs.Fields.Count - 1
0052 Debug.Print "Record " & j & ". Field " & i & " (" & rs.Fields(i).Name & ") = " & rs.Fields(i)
0053 Next i
0054 End If
0055 iLevel = rs.Fields(5)
0056 iLevel_Next = iLevel
0057 strNote_Title = rs.Fields(6) & ""
0058 iNote_ID = rs.Fields(7)
0059 strCaption = rs.Fields(8) & ""
0060 If Recursion_Local = False Then
0061 strFootnote = rs.Fields(9) & ""
0062 Exclusion = rs.Fields(10)
0063 strReason_Excluded = rs.Fields(11) & ""
0064 End If
0065 Concat_Categories = ""
0066 For i = 1 To 3
0067 Categories(i) = rs.Fields(i + 1) & ""
0068 Concat_Categories = Concat_Categories & Categories(i)
0069 Next i
0070 boolCategory_Header_Done = False
0071 'Find Level of next record
0072 If j >= irs_Count Then
0073 iLevel_Next = iLevel 'Least bad option?
0074 Else
0075 rs.MoveNext
0076 iLevel_Next = rs.Fields(5)
0077 rs.MovePrevious
0078 End If
0079 If (Concat_Categories <> Concat_Categories_Saved) Or (iLevel_Saved <> iLevel) Then
0080 'Finish off previous list
0081 If (iLevel_Saved <> 0) And (iLevel_Saved > iLevel) Then
0082 i = iLevel_Saved
0083 Do While i > iLevel
0084 Select Case (i)
0085 Case 2
0086 strPrint_Row = strPrint_Row & "|AA|"
0087 Case 3
0088 strPrint_Row = strPrint_Row & "|oo|"
0089 Case 4
0090 strPrint_Row = strPrint_Row & "|aa|"
0091 End Select
0092 Active_Levels(i) = False
0093 i = i - 1
0094 Loop
0095 End If
0096 'Insert header
0097 If (Categories(iLevel) <> strCaption) And (Categories(iLevel) <> "") Or (Recursion_Local = True And Categories(iLevel) <> "" And iLevel <> iLevel_Next) Then
0098 'Insert a Title
0099 Select Case iLevel
0100 Case 1, 2
0101 strPrint_Row = strPrint_Row & "|1|"
0102 Case 3
0103 strPrint_Row = strPrint_Row & "|.|"
0104 End Select
0105 strPrint_Row = strPrint_Row & Categories(iLevel)
0106 boolCategory_Header_Done = True
0107 End If
0108 End If
0109 If Active_Levels(iLevel) = False Then
0110 Active_Levels(iLevel) = True
0111 Select Case (iLevel)
0112 Case 2
0113 strPrint_Row = strPrint_Row & "|AA|"
0114 Case 3
0115 strPrint_Row = strPrint_Row & "|oo|"
0116 Case 4
0117 strPrint_Row = strPrint_Row & "|aa|"
0118 End Select
0119 End If
0120 strMarker = ""
0121 If (iLevel_Next > iLevel) Then
0122 Select Case (iLevel_Next)
0123 Case 2
0124 strMarker = "|AA|"
0125 Case 3
0126 strMarker = "|oo|"
0127 Case 4
0128 strMarker = "|aa|"
0129 End Select
0130 If (boolCategory_Header_Done = True) Then
0131 strPrint_Row = strPrint_Row & strMarker
0132 End If
0133 Active_Levels(iLevel_Next) = True
0134 End If
0135 If boolCategory_Header_Done = False Then
0136 i = iLevel
0137 Else
0138 i = iLevel_Next
0139 End If
0140 Select Case (i)
0141 Case 1, 2, 4
0142 strPrint_Row = strPrint_Row & "|1|"
0143 Case 3
0144 strPrint_Row = strPrint_Row & "|.|"
0145 End Select
0146 If Exclusion = True And Recursion_Local = False Then
0147 No_Print = "NP"
0148 Else
0149 No_Print = ""
0150 End If
0151 strPrint_Row = strPrint_Row & "[" & strCaption & "]++" & No_Print & iNote_ID & "++"
0152 If Recursion_Local = False Then
0153 If strReason_Excluded <> "" Then
0154 strPrint_Row = strPrint_Row & ". [Excluded]++FN|..||.|" & strReason_Excluded & "|..|++"
0155 End If
0156 End If
0157 If strFootnote <> "" Then
0158 strPrint_Row = strPrint_Row & ". Footnote++FN" & strFootnote & "++"
0159 End If
0160 strCell = ""
0161 If Recursion_Local = True Then
0162 OK = Functor_22(rs.Fields(9), strCell, rs.Fields(7), rs.Fields(10) & "", "De-Duplicate", rs.Fields(0))
0163 strPrint_Row = strPrint_Row & strCell
0164 End If
0165 If (boolCategory_Header_Done = False) Then
0166 strPrint_Row = strPrint_Row & strMarker
0167 End If
0168 strValue_Local = strValue_Local & strPrint_Row
0169 rs.MoveNext
0170 Concat_Categories_Saved = Concat_Categories
0171 If boolCategory_Header_Done = True Then
0172 iLevel_Saved = iLevel_Next
0173 Else
0174 iLevel_Saved = iLevel
0175 End If
0176 j = j + 1
0177 strPrint_Row = ""
0178Loop
0179'Finish off Levels
0180If Active_Levels(4) = True Then
0181 strValue_Local = strValue_Local & "|aa|"
0182End If
0183If Active_Levels(3) = True Then
0184 strValue_Local = strValue_Local & "|oo|"
0185End If
0186If Active_Levels(2) = True Then
0187 strValue_Local = strValue_Local & "|AA|"
0188End If
0189If Active_Levels(1) = True Then
0190 strValue_Local = strValue_Local & "|II|"
0191End If
0192strValue = strValue_Local
0193End Function

Procedures Calling This Procedure (Functor_Indented_List) Procedures Called By This Procedure (Functor_Indented_List) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_Indented_List_Development
Procedure Type: Public Function
Module: Testing
Lines of Code: 193
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_Indented_List_Development(rs As Recordset, strValue, Optional Recursion As Boolean)
0002Dim strValue_Local As String
0003Dim Recursion_Local As Boolean
0004Dim strCell As String
0005Dim Testing As Boolean
0006Dim i As Integer
0007Dim j As Integer
0008Dim iLevel As Integer
0009Dim iLevel_Saved As Integer
0010Dim iLevel_Next As Integer
0011Dim iNote_ID As Integer
0012Dim strCaption As String
0013Dim strFootnote As String
0014Dim Categories(4) As String
0015Dim Active_Levels(4) As Boolean
0016Dim Concat_Categories As String
0017Dim Concat_Categories_Saved As String
0018Dim No_Print As String
0019Dim strNote_Title As String
0020Dim strPrint_Row As String
0021Dim Exclusion As Boolean
0022Dim strReason_Excluded As String
0023Dim irs_Count As Integer
0024Dim boolCategory_Header_Done As Boolean
0025Dim strMarker As String
0026Testing = False
0027j = 1
0028rs.MoveLast
0029irs_Count = rs.RecordCount
0030rs.MoveFirst
0031If IsMissing(Recursion) Then
0032 Recursion_Local = False
0033Else
0034 Recursion_Local = Recursion
0035 strCell = ""
0036End If
0037If Recursion_Local = True Then
0038 'Stop
0039End If
0040strValue_Local = strValue
0041Concat_Categories = ""
0042Concat_Categories_Saved = ""
0043strPrint_Row = "|II|"
0044Active_Levels(1) = True
0045For i = 2 To 4
0046 Active_Levels(i) = False
0047Next i
0048strValue_Local = ""
0049Do Until rs.EOF
0050 If Testing = True Then
0051 For i = 0 To rs.Fields.Count - 1
0052 Debug.Print "Record " & j & ". Field " & i & " (" & rs.Fields(i).Name & ") = " & rs.Fields(i)
0053 Next i
0054 End If
0055 iLevel = rs.Fields(5)
0056 iLevel_Next = iLevel
0057 strNote_Title = rs.Fields(6) & ""
0058 iNote_ID = rs.Fields(7)
0059 strCaption = rs.Fields(8) & ""
0060 If Recursion_Local = False Then
0061 strFootnote = rs.Fields(9) & ""
0062 Exclusion = rs.Fields(10)
0063 strReason_Excluded = rs.Fields(11) & ""
0064 End If
0065 Concat_Categories = ""
0066 For i = 1 To 3
0067 Categories(i) = rs.Fields(i + 1) & ""
0068 Concat_Categories = Concat_Categories & Categories(i)
0069 Next i
0070 boolCategory_Header_Done = False
0071 'Find Level of next record
0072 If j >= irs_Count Then
0073 iLevel_Next = iLevel 'Least bad option?
0074 Else
0075 rs.MoveNext
0076 iLevel_Next = rs.Fields(5)
0077 rs.MovePrevious
0078 End If
0079 If (Concat_Categories <> Concat_Categories_Saved) Or (iLevel_Saved <> iLevel) Then
0080 'Finish off previous list
0081 If (iLevel_Saved <> 0) And (iLevel_Saved > iLevel) Then
0082 i = iLevel_Saved
0083 Do While i > iLevel
0084 Select Case (i)
0085 Case 2
0086 strPrint_Row = strPrint_Row & "|AA|"
0087 Case 3
0088 strPrint_Row = strPrint_Row & "|oo|"
0089 Case 4
0090 strPrint_Row = strPrint_Row & "|aa|"
0091 End Select
0092 Active_Levels(i) = False
0093 i = i - 1
0094 Loop
0095 End If
0096 'Insert header
0097 If (Categories(iLevel) <> strCaption) And (Categories(iLevel) <> "") Or (Recursion_Local = True And Categories(iLevel) <> "" And iLevel <> iLevel_Next) Then
0098 'Insert a Title
0099 Select Case iLevel
0100 Case 1, 2
0101 strPrint_Row = strPrint_Row & "|1|"
0102 Case 3
0103 strPrint_Row = strPrint_Row & "|.|"
0104 End Select
0105 strPrint_Row = strPrint_Row & Categories(iLevel)
0106 boolCategory_Header_Done = True
0107 End If
0108 End If
0109 If Active_Levels(iLevel) = False Then
0110 Active_Levels(iLevel) = True
0111 Select Case (iLevel)
0112 Case 2
0113 strPrint_Row = strPrint_Row & "|AA|"
0114 Case 3
0115 strPrint_Row = strPrint_Row & "|oo|"
0116 Case 4
0117 strPrint_Row = strPrint_Row & "|aa|"
0118 End Select
0119 End If
0120 strMarker = ""
0121 If (iLevel_Next > iLevel) Then
0122 Select Case (iLevel_Next)
0123 Case 2
0124 strMarker = "|AA|"
0125 Case 3
0126 strMarker = "|oo|"
0127 Case 4
0128 strMarker = "|aa|"
0129 End Select
0130 If (boolCategory_Header_Done = True) Or (Recursion_Local = True) Then
0131 strPrint_Row = strPrint_Row & strMarker
0132 End If
0133 Active_Levels(iLevel_Next) = True
0134 End If
0135 If boolCategory_Header_Done = False Then
0136 i = iLevel
0137 Else
0138 i = iLevel_Next
0139 End If
0140 Select Case (i)
0141 Case 1, 2, 4
0142 strPrint_Row = strPrint_Row & "|1|"
0143 Case 3
0144 strPrint_Row = strPrint_Row & "|.|"
0145 End Select
0146 If Exclusion = True And Recursion_Local = False Then
0147 No_Print = "NP"
0148 Else
0149 No_Print = ""
0150 End If
0151 strPrint_Row = strPrint_Row & "[" & strCaption & "]++" & No_Print & iNote_ID & "++"
0152 If Recursion_Local = False Then
0153 If strReason_Excluded <> "" Then
0154 strPrint_Row = strPrint_Row & ". [Reason Excluded]++FN|..||.|" & strReason_Excluded & ". |..|++"
0155 End If
0156 End If
0157 If strFootnote <> "" Then
0158 strPrint_Row = strPrint_Row & ". Footnote++FN" & strFootnote & "++"
0159 End If
0160 strCell = ""
0161 If Recursion_Local = True Then
0162 OK = Functor_22(rs.Fields(9), strCell, rs.Fields(7), rs.Fields(10) & "", "De-Duplicate", rs.Fields(0))
0163 strPrint_Row = strPrint_Row & strCell
0164 End If
0165 If (boolCategory_Header_Done = False) And (Recursion_Local = False) Then
0166 strPrint_Row = strPrint_Row & strMarker
0167 End If
0168 strValue_Local = strValue_Local & strPrint_Row
0169 rs.MoveNext
0170 Concat_Categories_Saved = Concat_Categories
0171 If boolCategory_Header_Done = True Then
0172 iLevel_Saved = iLevel_Next
0173 Else
0174 iLevel_Saved = iLevel
0175 End If
0176 j = j + 1
0177 strPrint_Row = ""
0178Loop
0179'Finish off Levels
0180If Active_Levels(4) = True Then
0181 strValue_Local = strValue_Local & "|aa|"
0182End If
0183If Active_Levels(3) = True Then
0184 strValue_Local = strValue_Local & "|oo|"
0185End If
0186If Active_Levels(2) = True Then
0187 strValue_Local = strValue_Local & "|AA|"
0188End If
0189If Active_Levels(1) = True Then
0190 strValue_Local = strValue_Local & "|II|"
0191End If
0192strValue = strValue_Local
0193End Function

Procedures Calling This Procedure (Functor_Indented_List_Development) Procedures Called By This Procedure (Functor_Indented_List_Development) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_Indented_List_Saved
Procedure Type: Public Function
Module: Testing
Lines of Code: 191
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_Indented_List_Saved(rs As Recordset, strValue, Optional Recursion As Boolean)
0002'This is a back-up "working copy" of Functor_Indented_List, created before the latest release of Functor_Indented_List_Development to Live
0003Dim strValue_Local As String
0004Dim Recursion_Local As Boolean
0005Dim strCell As String
0006Dim Testing As Boolean
0007Dim i As Integer
0008Dim j As Integer
0009Dim iLevel As Integer
0010Dim iLevel_Saved As Integer
0011Dim iLevel_Next As Integer
0012Dim iNote_ID As Integer
0013Dim strCaption As String
0014Dim strFootnote As String
0015Dim Categories(3) As String
0016Dim Active_Levels(4) As Boolean
0017Dim Concat_Categories As String
0018Dim Concat_Categories_Saved As String
0019Dim No_Print As String
0020Dim strNote_Title As String
0021Dim strPrint_Row As String
0022Dim Exclusion As Boolean
0023Dim strReason_Excluded As String
0024Dim irs_Count As Integer
0025Dim boolCategory_Header_Done As Boolean
0026Dim strMarker As String
0027Testing = False
0028j = 1
0029rs.MoveLast
0030irs_Count = rs.RecordCount
0031rs.MoveFirst
0032If IsMissing(Recursion) Then
0033 Recursion_Local = False
0034Else
0035 Recursion_Local = Recursion
0036 strCell = ""
0037End If
0038strValue_Local = strValue
0039Concat_Categories = ""
0040Concat_Categories_Saved = ""
0041strPrint_Row = "|II|"
0042Active_Levels(1) = True
0043For i = 2 To 4
0044 Active_Levels(i) = False
0045Next i
0046strValue_Local = ""
0047Do Until rs.EOF
0048 If Testing = True Then
0049 For i = 0 To rs.Fields.Count - 1
0050 Debug.Print "Record " & j & ". Field " & i & " (" & rs.Fields(i).Name & ") = " & rs.Fields(i)
0051 Next i
0052 End If
0053 iLevel = rs.Fields(5)
0054 iLevel_Next = iLevel
0055 strNote_Title = rs.Fields(6) & ""
0056 iNote_ID = rs.Fields(7)
0057 strCaption = rs.Fields(8) & ""
0058 If Recursion_Local = False Then
0059 strFootnote = rs.Fields(9) & ""
0060 Exclusion = rs.Fields(10)
0061 strReason_Excluded = rs.Fields(11) & ""
0062 End If
0063 Concat_Categories = ""
0064 For i = 1 To 3
0065 Categories(i) = rs.Fields(i + 1) & ""
0066 Concat_Categories = Concat_Categories & Categories(i)
0067 Next i
0068 boolCategory_Header_Done = False
0069 If (Concat_Categories <> Concat_Categories_Saved) Or (iLevel_Saved <> iLevel) Then
0070 'Finish off previous list
0071 If (iLevel_Saved <> 0) And (iLevel_Saved > iLevel) Then
0072 For i = iLevel + 1 To iLevel_Saved
0073 Select Case (i)
0074 Case 2
0075 strPrint_Row = strPrint_Row & "|AA|"
0076 Case 3
0077 strPrint_Row = strPrint_Row & "|oo|"
0078 Case 4
0079 strPrint_Row = strPrint_Row & "|aa|"
0080 End Select
0081 Active_Levels(i) = False
0082 Next i
0083 End If
0084 'Insert header
0085 If (Categories(iLevel) <> strCaption) And (Categories(iLevel) <> "") Then
0086 'Insert a Title
0087 Select Case iLevel
0088 Case 1, 2
0089 strPrint_Row = strPrint_Row & "|1|"
0090 Case 3
0091 strPrint_Row = strPrint_Row & "|.|"
0092 End Select
0093 strPrint_Row = strPrint_Row & Categories(iLevel)
0094 boolCategory_Header_Done = True
0095 End If
0096 End If
0097 'Find Level of next record '... moved from above
0098 If iLevel_Saved <> 0 Then
0099 If j >= irs_Count Then
0100 iLevel_Next = iLevel 'Least bad option?
0101 Else
0102 rs.MoveNext
0103 iLevel_Next = rs.Fields(5)
0104 rs.MovePrevious
0105 End If
0106 End If
0107 If Active_Levels(iLevel) = False Then 'Added
0108 Active_Levels(iLevel) = True
0109 Select Case (iLevel)
0110 Case 2
0111 strPrint_Row = strPrint_Row & "|AA|"
0112 Case 3
0113 strPrint_Row = strPrint_Row & "|oo|"
0114 Case 4
0115 strPrint_Row = strPrint_Row & "|aa|"
0116 End Select
0117 End If
0118 strMarker = ""
0119 If (iLevel_Next > iLevel) And (iLevel_Saved <> 0) Then
0120 Select Case (iLevel_Next)
0121 Case 2
0122 strMarker = "|AA|"
0123 Case 3
0124 strMarker = "|oo|"
0125 Case 4
0126 strMarker = "|aa|"
0127 End Select
0128 If boolCategory_Header_Done = True Then
0129 strPrint_Row = strPrint_Row & strMarker
0130 End If
0131 Active_Levels(iLevel_Next) = True
0132 End If
0133 If boolCategory_Header_Done = False Then
0134 i = iLevel
0135 Else
0136 i = iLevel_Next
0137 End If
0138 Select Case (i)
0139 Case 1, 2, 4
0140 strPrint_Row = strPrint_Row & "|1|"
0141 Case 3
0142 strPrint_Row = strPrint_Row & "|.|"
0143 End Select
0144 If Exclusion = True And Recursion_Local = False Then
0145 No_Print = "NP"
0146 Else
0147 No_Print = ""
0148 End If
0149 strPrint_Row = strPrint_Row & "[" & strCaption & "]++" & No_Print & iNote_ID & "++"
0150 If Recursion_Local = False Then
0151 If strReason_Excluded <> "" Then
0152 strPrint_Row = strPrint_Row & ". [Reason Excluded]++FN|..||.|" & strReason_Excluded & ". |..|++"
0153 End If
0154 End If
0155 If strFootnote <> "" Then
0156 strPrint_Row = strPrint_Row & ". Footnote++FN" & strFootnote & "++"
0157 End If
0158 strCell = ""
0159 If Recursion_Local = True Then
0160 OK = Functor_22(rs.Fields(9), strCell, rs.Fields(7), rs.Fields(10) & "", "De-Duplicate", rs.Fields(0))
0161 strPrint_Row = strPrint_Row & strCell
0162 End If
0163 If boolCategory_Header_Done = False Then
0164 strPrint_Row = strPrint_Row & strMarker
0165 End If
0166 strValue_Local = strValue_Local & strPrint_Row
0167 rs.MoveNext
0168 Concat_Categories_Saved = Concat_Categories
0169 If boolCategory_Header_Done = True Then
0170 iLevel_Saved = iLevel_Next
0171 Else
0172 iLevel_Saved = iLevel
0173 End If
0174 j = j + 1
0175 strPrint_Row = ""
0176Loop
0177'Finish off Levels
0178If Active_Levels(4) = True Then
0179 strValue_Local = strValue_Local & "|aa|"
0180End If
0181If Active_Levels(3) = True Then
0182 strValue_Local = strValue_Local & "|oo|"
0183End If
0184If Active_Levels(2) = True Then
0185 strValue_Local = strValue_Local & "|AA|"
0186End If
0187If Active_Levels(1) = True Then
0188 strValue_Local = strValue_Local & "|II|"
0189End If
0190strValue = strValue_Local
0191End Function

Procedures Called By This Procedure (Functor_Indented_List_Saved) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Update_Live_Notes_Functor
Procedure Type: Public Function
Module: Testing
Lines of Code: 120
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Update_Live_Notes_Functor()
0002Dim strQuery As String
0003Dim All_Notes As Boolean
0004Dim rs As Recordset
0005Dim rsNotes_Archive As Recordset
0006Dim rsNotes_To_Regen As Recordset
0007Dim rs2 As Recordset
0008Dim i As Integer
0009Dim Note_ID_Local As Long
0010Dim Note_ID_Selected As Long
0011Dim Note_Title As String
0012Dim Note_Text As String
0013Dim Update_Notes_Archive As Boolean
0014Note_ID_Selected = InputBox("Enter a Note ID, or 0 for all non-Temp PID Notes, or default for all recently imported Aeon files", "Input Note ID", 99999)
0015i = 0
0016Update_Notes_Archive = False
0017Select Case Note_ID_Selected
0018 Case 0 'All non-Temp PID Notes with Functors only
0019 All_Notes = True
0020 strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text FROM Notes WHERE (((Notes.Note_Group) = 1) And ((Notes.Status & """") <> ""Temp"") And ((InStr([Item_Text], ""Functor"")) > 0)) ORDER BY Notes.Item_Title;"
0021 Case 99999
0022 All_Notes = True
0023 strQuery = "SELECT Aeon_Date_Fixes.Note_ID FROM Aeon_Date_Fixes GROUP BY Aeon_Date_Fixes.Note_ID;"
0024 Case Else
0025 All_Notes = False
0026 strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text FROM Notes WHERE (((Notes.ID) = " & Note_ID_Selected & "));"
0027End Select
0028Set rs = CurrentDb.OpenRecordset(strQuery)
0029If Not rs.EOF Then
0030 rs.MoveLast
0031 i = rs.RecordCount
0032 rs.MoveFirst
0033 If i = 1 Then
0034 If MsgBox("Output Note " & rs.Fields(0) & " (" & rs.Fields(1) & ")", vbYesNo) = vbNo Then
0035 MsgBox ("Try Again")
0036 Exit Function
0037 End If
0038 Else
0039 If MsgBox("Output all " & i & " selected Notes?", vbYesNo) = vbNo Then
0040 MsgBox ("Try Again")
0041 Exit Function
0042 End If
0043 End If
0044Else
0045 MsgBox ("Enter a valid Note ID")
0046 Exit Function
0047End If
0048i = 0
0049'Clear the Notes_To_Regen table ...
0050 strQuery = "DELETE * FROM Notes_To_Regen;"
0051DoCmd.RunSQL (strQuery)
0052 Set rsNotes_To_Regen = CurrentDb.OpenRecordset("SELECT * FROM Notes_To_Regen;")
0053'Regenerate the selected Notes
0054Do Until rs.EOF
0055 Update_Notes_Archive = False
0056 Note_ID_Local = rs.Fields(0)
0057 If Note_ID_Selected <> 99999 Then
0058 Note_Title = rs.Fields(1)
0059 Note_Text = rs.Fields(2)
0060 Else
0061 strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text FROM Notes WHERE (((Notes.ID) = " & Note_ID_Local & "));"
0062 Set rs2 = CurrentDb.OpenRecordset(strQuery)
0063 If Not rs2.EOF Then
0064 rs2.MoveFirst
0065 Note_Title = rs2.Fields(1)
0066 Note_Text = rs2.Fields(2)
0067 End If
0068 End If
0069 'Find the latest Archive Note
0070 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text, Notes_Archive.Timestamp FROM Notes_Archive WHERE (((Notes_Archive.ID) = " & Note_ID_Local & ")) ORDER BY Notes_Archive.Timestamp DESC;"
0071 Set rsNotes_Archive = CurrentDb.OpenRecordset(strQuery)
0072 If Not rsNotes_Archive.EOF Then
0073 rsNotes_Archive.MoveFirst
0074 If Note_Text = rsNotes_Archive.Fields(1) Then
0075 Update_Notes_Archive = True
0076 End If
0077 End If
0078 're-Functor the Note
0079 OK = Functor(Note_ID_Local, Note_Title, Note_Text)
0080 'Update the Note
0081 If Note_ID_Selected = 99999 Then
0082 If Not rs2.EOF Then
0083 rs2.MoveFirst
0084 rs2.Edit
0085 rs2.Fields(2) = Note_Text
0086 rs2.Update
0087 Set rs2 = Nothing
0088 End If
0089 Else
0090 rs.Edit
0091 rs.Fields(2) = Note_Text
0092 rs.Update
0093 End If
0094 'Add a line to the Notes_to_Regen table
0095 rsNotes_To_Regen.AddNew
0096 rsNotes_To_Regen.Fields(0) = Note_ID_Local
0097 rsNotes_To_Regen.Fields(1) = Now()
0098 rsNotes_To_Regen.Update
0099 'Update the latest Archived_Note
0100 If Update_Notes_Archive = True Then
0101 rsNotes_Archive.Edit
0102 rsNotes_Archive.Fields(1) = Note_Text
0103 rsNotes_Archive.Update
0104 End If
0105 i = i + 1
0106 rs.MoveNext
0107Loop
0108'Output the Notes
0109If i > 0 Then
0110 If MsgBox("Output " & i & " updated Notes?", vbYesNo) = vbYes Then
0111 Archive_Notes_Now = "No"
0112 Regenerate_the_Links = "No"
0113 Regen_Notes_Only = "Yes"
0114 CreateNotesWebPages
0115 End If
0116End If
0117Set rs = Nothing
0118Set rsNotes_Archive = Nothing
0119Set rsNotes_To_Regen = Nothing
0120End Function

Procedures Calling This Procedure (Update_Live_Notes_Functor) Procedures Called By This Procedure (Update_Live_Notes_Functor) Tables / Queries / Fragments Directly Used By This Procedure (Update_Live_Notes_Functor) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Update_Thesis_Chapter_RLs
Procedure Type: Public Function
Module: Testing
Lines of Code: 41
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Update_Thesis_Chapter_RLs(Note_ID)
0002Dim strQuery As String
0003Dim rs As Recordset
0004Dim Chapter_FieldName As String
0005Dim PID_Note_ID As Long
0006'Determine the column name in PID_Note_Reading_Lists table
0007 strQuery = "SELECT Thesis_Chapters.ID, Thesis_Chapters.Chapter FROM Thesis_Chapters WHERE (((Thesis_Chapters.ID)=" & Note_ID & "));"
0008Set rs = CurrentDb.OpenRecordset(strQuery)
0009If rs.EOF Then
0010 Update_Thesis_Chapter_RLs = "Invalid Thesis Chapter Note_ID"
0011 Exit Function
0012Else
0013 rs.MoveFirst
0014 Chapter_FieldName = rs.Fields(1)
0015 Chapter_FieldName = "Ch_" & Chapter_FieldName & "_Ist_Note"
0016End If
0017'Reset Column to 0
0018 strQuery = "UPDATE PID_Note_Reading_Lists SET PID_Note_Reading_Lists." & Chapter_FieldName & " = 0;"
0019DoCmd.RunSQL (strQuery)
0020'Determine Notes in Chapter (in sequence) - Ignore those flagged "ignore"
0021 strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_ID FROM Thesis_Note_XRef INNER JOIN Notes ON Thesis_Note_XRef.PID_Note_ID = Notes.ID WHERE (((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_ID & ") And ((Thesis_Note_XRef.[Exclude?]) = No)) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title;"
0022Set rs = CurrentDb.OpenRecordset(strQuery)
0023If rs.EOF Then
0024 Update_Thesis_Chapter_RLs = "No Notes in Thesis Chapter"
0025 Exit Function
0026Else
0027 rs.MoveFirst
0028End If
0029Do While Not rs.EOF
0030 PID_Note_ID = rs.Fields(1)
0031 'Now update rows for this Note in PID_Note_Reading_Lists to say accessed by this Thesis Chapter
0032 strQuery = "UPDATE PID_Note_Reading_Lists SET PID_Note_Reading_Lists." & Chapter_FieldName & " = " & PID_Note_ID & " WHERE (((PID_Note_Reading_Lists.Note_ID)=" & PID_Note_ID & ") AND ((PID_Note_Reading_Lists." & Chapter_FieldName & ")<>999999));"
0033 DoCmd.RunSQL (strQuery)
0034 'Now need to set rows in PID_Note_Reading_Lists for the Books / Papers selected above to have "999999" in the Chapter_FieldName column
0035 strQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN PID_Note_Reading_Lists AS PID_Note_Reading_Lists_1 ON (PID_Note_Reading_Lists.[Book/Paper] = PID_Note_Reading_Lists_1.[Book/Paper]) AND (PID_Note_Reading_Lists.Called_ID = PID_Note_Reading_Lists_1.Called_ID) SET PID_Note_Reading_Lists_1." & Chapter_FieldName & " = 999999 WHERE (((PID_Note_Reading_Lists_1." & Chapter_FieldName & ")=0) AND ((PID_Note_Reading_Lists." & Chapter_FieldName & ")=" & PID_Note_ID & "));"
0036 DoCmd.RunSQL (strQuery)
0037 rs.MoveNext
0038Loop
0039Update_Thesis_Chapter_RLs = "OK"
0040Set rs = Nothing
0041End Function

Procedures Calling This Procedure (Update_Thesis_Chapter_RLs) Tables / Queries / Fragments Directly Used By This Procedure (Update_Thesis_Chapter_RLs) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


© Theo Todman, June 2007 - May 2025. Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Philosophy Page Return to Theo Todman's Home Page