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 20 (3 items)

Combo1_ChangeCreateCodeWebpagesMonthly_Report_Note975_Update.

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

Go to top of page



Source Code of: Combo1_Change
Procedure Type: Private Sub
Module: Form_Notes_Archive_Regen
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub Combo1_Change()
0002[Forms]![Notes_Archive_Regen]![Combo3] = Null
0003[Forms]![Notes_Archive_Regen]![Combo5] = Null
0004End Sub

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: CreateCodeWebpages
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 312
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub CreateCodeWebpages()
0002Dim rsTableControl As Recordset
0003Dim strControlQuery As String
0004Dim strLine As String
0005Dim iTableColumns As Integer
0006Dim i As Long
0007Dim strFileSuffix As String
0008Dim strFileBody As String
0009Dim Procedure_Type As String
0010Dim Heading As String
0011Dim rsTableToRead As Recordset
0012Dim rsTableToRead2 As Recordset
0013Dim Procedure_Location As Integer
0014Dim Procedure_Location_Saved As Integer
0015Dim This_Location As Integer
0016Dim This_Object As String
0017Dim This_Object_Type As String
0018Dim This_Object_Count As String
0019Dim This_Line As Integer
0020Dim Last_Location As Integer
0021Dim Last_Object As String
0022Dim Last_Object_Type As String
0023Dim Last_Line As Integer
0024Dim Time_Stamp As String
0025'Create the Code Detail Files (by Location)
0026'Read the data
0027 strDataQuery = "SELECT Code_Table.Procedure_Type, Code_Table.Procedure_Name, Code_Table.Code_Location, Code_Table.ID, Code_Table.Code, Code_Table.Module, Code_Table.Lines FROM Code_Table ORDER BY Code_Table.Code_Location, Code_Table.Procedure_Name;"
0028Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery)
0029rsTableToRead.MoveFirst
0030Procedure_Location = rsTableToRead.Fields(2)
0031Procedure_Location_Saved = Procedure_Location
0032'Create First File
0033strOutputFileShort = SubSystem & "Documentation_Code_" & Procedure_Location
0034Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFolder & strFileBody & strOutputFileShort & ".htm", True, True)
0035'Create First Page Header
0036 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0037Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0038rsTableControl.MoveFirst
0039Do While Not rsTableControl.EOF
0040 strLine = rsTableControl.Fields(0) & ""
0041 tsTextFile.WriteLine strLine
0042 rsTableControl.MoveNext
0043Loop
0044Procedure_Location = rsTableToRead.Fields(2)
0045'Create Jump Table
0046iTableColumns = 4
0047Procedure_Type = "Location"
0048Heading = "Code Documentation Location " & Procedure_Location
0049 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0050Do Until rsTableToRead.EOF
0051 Procedure_Location = rsTableToRead.Fields(2)
0052 If Procedure_Location <> Procedure_Location_Saved Then
0053 Procedure_Location_Saved = Procedure_Location
0054 'Finish previous file
0055 'Create Page Footer
0056 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0057 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0058 rsTableControl.MoveFirst
0059 Do While Not rsTableControl.EOF
0060 Time_Stamp = rsTableControl.Fields(0) & ""
0061 OK = Replace_Timestamp(Time_Stamp)
0062 tsTextFile.WriteLine Time_Stamp
0063 rsTableControl.MoveNext
0064 Loop
0065 'Copy to Transfer
0066 strFileSuffix = strOutputFileShort
0067 OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm")
0068 Set tsTextFile = Nothing
0069 'Create Next File
0070 strOutputFileShort = SubSystem & "Documentation_Code_" & Procedure_Location
0071 Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFolder & strFileBody & strOutputFileShort & ".htm", True, True)
0072 'Create Page Header
0073 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0074 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0075 rsTableControl.MoveFirst
0076 Do While Not rsTableControl.EOF
0077 strLine = rsTableControl.Fields(0) & ""
0078 tsTextFile.WriteLine strLine
0079 rsTableControl.MoveNext
0080 Loop
0081 'Create Jump Table
0082 iTableColumns = 4
0083 Procedure_Type = "Location"
0084 Heading = "Code Documentation Location " & Procedure_Location
0085 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0086 End If
0087 'Create Main Text
0088 'Rule off ready for next procedure
0089 strLine = "<BR><HR><BR>"
0090 tsTextFile.WriteLine strLine
0091 Heading = rsTableToRead.Fields(1)
0092 strLine = "<A Name =""" & Heading & """></A>" & "<U><B>Source Code of</U>: " & Heading & "</B><BR>"
0093 strLine = strLine & "<U><B>Procedure Type</U>: " & rsTableToRead.Fields(0) & "</B><BR>"
0094 strLine = strLine & "<U><B>Module</U>: " & rsTableToRead.Fields(5) & "</B><BR>"
0095 strLine = strLine & "<U><B>Lines of Code</U>: " & rsTableToRead.Fields(6) & "</B><BR>"
0096 tsTextFile.WriteLine strLine
0097 'Create link to bottom of Procedure
0098 If rsTableToRead.Fields(6) > 20 Then
0099 strLine = "<A HREF=""#" & Heading & "_Bottom"">Go To End of This Procedure</A><br>"
0100 Else
0101 strLine = "<br>"
0102 End If
0103 tsTextFile.WriteLine strLine
0104 OK = Parse_Code_To_Wepage(rsTableToRead.Fields(4))
0105 strLine = "<A Name =""" & Heading & "_Bottom""></A>"
0106 tsTextFile.WriteLine strLine
0107 'Create Code Links In
0108 strDataQuery = "SELECT Code_Links_Table.Called_Procedure_Name, Code_Links_Table.Calling_Procedure_Name, Code_Links_Table.Calling_Procedure_Line, Code_Table.Code_Location FROM Code_Links_Table INNER JOIN Code_Table ON Code_Links_Table.Calling_Procedure_Name = Code_Table.Procedure_Name WHERE (((Code_Links_Table.Called_Procedure_Name) = """ & Heading & """)) ORDER BY Code_Links_Table.Calling_Procedure_Name, Code_Links_Table.Calling_Procedure_Line;"
0109 Set rsTableToRead2 = CurrentDb.OpenRecordset(strDataQuery)
0110 If Not rsTableToRead2.EOF Then
0111 rsTableToRead2.MoveFirst
0112 strLine = "<U><B>Procedures Calling This Procedure</U></B> (" & Heading & ")<UL>"
0113 tsTextFile.WriteLine strLine
0114 strLine = ""
0115 Last_Object = "zzzz"
0116 This_Object_Count = 0
0117 Do While Not rsTableToRead2.EOF
0118 This_Location = rsTableToRead2.Fields(3)
0119 This_Object = rsTableToRead2.Fields(1)
0120 This_Line = rsTableToRead2.Fields(2)
0121 If Last_Object = This_Object Then
0122 If This_Object_Count = 1 Then
0123 strLine = "<LI>" & Last_Object & " (From Lines " & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>, "
0124 Else
0125 strLine = strLine & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>, "
0126 End If
0127 This_Object_Count = This_Object_Count + 1
0128 Else
0129 If Last_Object <> "zzzz" Then
0130 If This_Object_Count = 1 Then
0131 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Object & "</A> (From Line " & Last_Line & ")</LI>"
0132 Else
0133 strLine = strLine & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0134 End If
0135 tsTextFile.WriteLine strLine
0136 End If
0137 This_Object_Count = 1
0138 End If
0139 rsTableToRead2.MoveNext
0140 Last_Location = This_Location
0141 Last_Object = This_Object
0142 Last_Line = This_Line
0143 Loop
0144 'Last line
0145 If Last_Object <> "zzzz" Then
0146 If This_Object_Count = 1 Then
0147 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Object & "</A> (From Line " & Last_Line & ")</LI>"
0148 Else
0149 strLine = strLine & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0150 End If
0151 tsTextFile.WriteLine strLine
0152 End If
0153 strLine = "</UL>"
0154 tsTextFile.WriteLine strLine
0155 End If
0156 'Create Code Links Out
0157 strDataQuery = "SELECT Code_Links_Table.Calling_Procedure_Name, Code_Links_Table.Called_Procedure_Name, Code_Links_Table.Calling_Procedure_Line, Code_Table.Code_Location FROM Code_Links_Table INNER JOIN Code_Table ON Code_Links_Table.Called_Procedure_Name = Code_Table.Procedure_Name WHERE (((Code_Links_Table.Calling_Procedure_Name) = """ & Heading & """)) ORDER BY Code_Links_Table.Called_Procedure_Name, Code_Links_Table.Calling_Procedure_Line;"
0158 Set rsTableToRead2 = CurrentDb.OpenRecordset(strDataQuery)
0159 If Not rsTableToRead2.EOF Then
0160 rsTableToRead2.MoveFirst
0161 strLine = "<U><B>Procedures Called By This Procedure</U></B> (" & Heading & ")<UL>"
0162 tsTextFile.WriteLine strLine
0163 strLine = ""
0164 Last_Object = "zzzz"
0165 This_Object_Count = 0
0166 Do While Not rsTableToRead2.EOF
0167 This_Location = rsTableToRead2.Fields(3)
0168 This_Object = rsTableToRead2.Fields(1)
0169 This_Line = rsTableToRead2.Fields(2)
0170 If Last_Object = This_Object Then
0171 If This_Object_Count = 1 Then
0172 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & """>" & Last_Object & "</A> (From Lines <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>, "
0173 Else
0174 strLine = strLine & "<A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>, "
0175 End If
0176 This_Object_Count = This_Object_Count + 1
0177 Else
0178 If Last_Object <> "zzzz" Then
0179 If This_Object_Count = 1 Then
0180 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & """>" & Last_Object & "</A> (From Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0181 Else
0182 strLine = strLine & "<A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0183 End If
0184 tsTextFile.WriteLine strLine
0185 End If
0186 This_Object_Count = 1
0187 End If
0188 rsTableToRead2.MoveNext
0189 Last_Location = This_Location
0190 Last_Object = This_Object
0191 Last_Line = This_Line
0192 Loop
0193 'Last line
0194 If Last_Object <> "zzzz" Then
0195 If This_Object_Count = 1 Then
0196 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & """>" & Last_Object & "</A> (From Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0197 Else
0198 strLine = strLine & "<A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0199 End If
0200 tsTextFile.WriteLine strLine
0201 End If
0202 strLine = "</UL>"
0203 tsTextFile.WriteLine strLine
0204 End If
0205 'Create Query / Table / Fragment Links Out
0206 strDataQuery = "SELECT Query_Links_Table.Object_2, Query_Links_Table.Object_2_Type, Query_Links_Table.Code_Line, Query_Definitions.Query_Type FROM Query_Links_Table LEFT JOIN Query_Definitions ON Query_Links_Table.Object_2 = Query_Definitions.Query_Name WHERE (Query_Links_Table.Object_1 = """ & Heading & """) ORDER BY Query_Links_Table.Object_2, Query_Links_Table.Code_Line;"
0207 Set rsTableToRead2 = CurrentDb.OpenRecordset(strDataQuery)
0208 If Not rsTableToRead2.EOF Then
0209 rsTableToRead2.MoveFirst
0210 strLine = "<U><B>Tables / Queries / Fragments Directly Used By This Procedure</U></B> (" & Heading & ")<UL>"
0211 tsTextFile.WriteLine strLine
0212 strLine = ""
0213 Last_Object = "zzzz"
0214 This_Object_Count = 0
0215 Do While Not rsTableToRead2.EOF
0216 This_Object_Type = rsTableToRead2.Fields(1)
0217 If This_Object_Type = "Q" Then
0218 This_Location = rsTableToRead2.Fields(3) 'Using "This Location" as a proxy for "Query Type"
0219 Else
0220 This_Location = 0
0221 End If
0222 This_Object = rsTableToRead2.Fields(0)
0223 This_Line = rsTableToRead2.Fields(2)
0224 If Last_Object = This_Object Then
0225 If This_Object_Count = 1 Then
0226 If Last_Object_Type = "Q" Then
0227 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Queries_" & Last_Location & ".htm#" & Last_Object & """>" & Last_Object & "</A> (Query, used in Lines <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>, "
0228 Else
0229 If Last_Object_Type = "T" Then
0230 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Tables.htm#" & Last_Object & """>" & Last_Object & "</A> (Table, used in Lines <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>, "
0231 Else
0232 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Fragments.htm#" & Last_Object & """>" & Last_Object & "</A> (Query Fragment, used in Lines <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>, "
0233 End If
0234 End If
0235 Else
0236 strLine = strLine & "<A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>, "
0237 End If
0238 This_Object_Count = This_Object_Count + 1
0239 Else
0240 If Last_Object <> "zzzz" Then
0241 If This_Object_Count = 1 Then
0242 If Last_Object_Type = "Q" Then
0243 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Queries_" & Last_Location & ".htm#" & Last_Object & """>" & Last_Object & "</A> (Query, used in Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0244 Else
0245 If Last_Object_Type = "T" Then
0246 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Tables.htm#" & Last_Object & """>" & Last_Object & "</A> (Table, used in Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0247 Else
0248 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Fragments.htm#" & Last_Object & """>" & Last_Object & "</A> (Query Fragment, used in Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0249 End If
0250 End If
0251 Else
0252 strLine = strLine & "<A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0253 End If
0254 tsTextFile.WriteLine strLine
0255 End If
0256 This_Object_Count = 1
0257 End If
0258 rsTableToRead2.MoveNext
0259 Last_Location = This_Location
0260 Last_Object = This_Object
0261 Last_Line = This_Line
0262 Last_Object_Type = This_Object_Type
0263 Loop
0264 'Last line
0265 If Last_Object <> "zzzz" Then
0266 If This_Object_Count = 1 Then
0267 If Last_Object_Type = "Q" Then
0268 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Queries_" & Last_Location & ".htm#" & Last_Object & """>" & Last_Object & "</A> (Query, used in Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0269 Else
0270 If Last_Object_Type = "T" Then
0271 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Tables.htm#" & Last_Object & """>" & Last_Object & "</A> (Table, used in Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0272 Else
0273 strLine = "<LI><A HREF=""" & SubSystem & "Documentation_Code_Fragments.htm#" & Last_Object & """>" & Last_Object & "</A> (Query Fragment, used in Line <A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0274 End If
0275 End If
0276 Else
0277 strLine = strLine & "<A HREF=""#" & Heading & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0278 End If
0279 tsTextFile.WriteLine strLine
0280 End If
0281 strLine = "</UL>"
0282 tsTextFile.WriteLine strLine
0283 End If
0284 'Create link to top of Procedure
0285 If rsTableToRead.Fields(6) > 20 Then
0286 strLine = "<A HREF=""#" & Heading & """>Go To Start of This Procedure</A><br>"
0287 tsTextFile.WriteLine strLine
0288 End If
0289 'Create link to top of page
0290 strLine = "<A HREF=""#Top"">Go To Top of This Page</A><br>"
0291 tsTextFile.WriteLine strLine
0292 'Create link to main code jump-table
0293 strLine = "<A HREF=""" & SubSystem & "DocumentationControl.htm"">Link to VBA Code Control Page</A><br>"
0294 tsTextFile.WriteLine strLine
0295 rsTableToRead.MoveNext
0296Loop
0297'Finish Last File
0298'Page Footer
0299 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0300Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0301rsTableControl.MoveFirst
0302Do While Not rsTableControl.EOF
0303 Time_Stamp = rsTableControl.Fields(0) & ""
0304 OK = Replace_Timestamp(Time_Stamp)
0305 tsTextFile.WriteLine Time_Stamp
0306 rsTableControl.MoveNext
0307Loop
0308'Copy to Transfer
0309strFileSuffix = strOutputFileShort
0310 OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm")
0311Set tsTextFile = Nothing
0312End Sub

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


Source Code of: Monthly_Report_Note975_Update
Procedure Type: Public Sub
Module: Monthly Reporting
Lines of Code: 361
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Monthly_Report_Note975_Update(YTD)
0002'This Sub now produces both the Quarterly Note (975) and the Annual Note (1266)
0003Dim Start_Time As Date
0004Dim strLine As String
0005Dim rsTableControl As Recordset
0006Dim rsTableControl2 As Recordset
0007Dim rsTableControl3 As Recordset
0008Dim rsTableControl4 As Recordset
0009Dim i As Integer
0010Dim ProjectSaved As String
0011Dim ProjectTemp As String
0012Dim Sub_projects As String
0013Dim Sub_Project_Temp As String
0014Dim Sub_Project_Saved As String
0015Dim Paper_Saved As String
0016Dim Last_Paper_Displayed As String
0017Dim Status_Project As Integer
0018Dim Status_Line As String
0019Dim Temp_Line As String
0020Dim strNote_Period As String
0021Dim Status_Project_Name As String
0022Dim Note_ID As Integer
0023Dim strReporting_Year As String
0024Dim Total_Time_outstanding_this_period As Single
0025Dim Sub_Total As Single
0026Dim Aeon_Link As String
0027Dim strQuery As String
0028Dim Aeon_FN As String
0029Dim strAeon_WebRef As String
0030Dim Aeon_WebRef As Integer
0031Dim Bible As String
0032Bible = "|.|Below is a table showing the progress on my project to read the OT, LXX & NT in the original Hebrew and Greek. "
0033Bible = Bible & "|.|As of the beginning of August 2025, this project is in abeyance (again). I've decided to enhance my grammatical knowledge of Greek and Hebrew before proceding further. "
0034Bible = Bible & "|.|The table below has been corrected to reflect the second intermission. The Revised End Date is calculated as 'today' plus the amount of time needed to complete the tasks at the rate achieved during the second period of activity. Hence, it will advance by one day a day until I restart. "
0035Bible = Bible & "|.|The explanation after the first intermission is as below. "
0036Bible = Bible & "|ii||1|I'm on my first pass through the OT & LXX and my second pass through the NT. |1|I intermitted this project between August 2023 and April 2024 (inclusive; ie. 9 months); as well as deferring completion by 9 months, this has thrown out my completion-date algorithms somewhat. For now, I've amended the Completion Aims to reflect the intermission. |1|I've calculated and used the daily rate of progress achieved prior to intermission to calculate the estimated completion date. |1|I don't now have as much time to spare, so - as expected - this rate has fallen since the restart. |1|I've therefore also calculated and used the daily rate of progress achieved since intermission to calculate the revised completion date. |ii|"
0037Bible = Bible & "|.|I've also read through the Koran, but mostly in English. One day I'll try to read the Koran in Arabic, maybe. Progress on this, and on my first run-through of the NT, is recorded in versions of this report prior to 25Q3. <br>"
0038Start_Time = Now()
0039If YTD = "No" Then
0040 Note_ID = 975
0041Else
0042 Note_ID = 1266
0043End If
0044'Determine the Parameters
0045 Set rsTableControl2 = CurrentDb.OpenRecordset("SELECT Next_Reporting_Month.* FROM Next_Reporting_Month;")
0046'Determine File Suffix
0047rsTableControl2.MoveFirst
0048strFile_Suffix = rsTableControl2.Fields(8)
0049iStart_Reporting_Month = rsTableControl2.Fields(1)
0050iEnd_Reporting_Month = rsTableControl2.Fields(2)
0051iReporting_Year = rsTableControl2.Fields(5) ' .... Start Year
0052strReporting_Year = iReporting_Year
0053If iEnd_Reporting_Month < 10 Then
0054 If YTD = "No" Then
0055 iReporting_Year = iReporting_Year + 1
0056 End If
0057 strReporting_Year = iReporting_Year + 1
0058End If
0059'Determine the Title year & months ...
0060If YTD = "No" Then
0061 If iEnd_Reporting_Month = 12 And Month(Now()) < 4 Then
0062 StrTitle_Year = Year(Now()) - 1
0063 StrTitle_Month = MonthName(iStart_Reporting_Month) & " - December"
0064 strNote_Period = "Q4"
0065 Else
0066 Select Case iStart_Reporting_Month
0067 Case 1
0068 strNote_Period = "Q1"
0069 Case 4
0070 strNote_Period = "Q2"
0071 Case 7
0072 strNote_Period = "Q3"
0073 Case 10
0074 strNote_Period = "Q4"
0075 End Select
0076 StrTitle_Year = Year(Now())
0077 StrTitle_Month = MonthName(iStart_Reporting_Month)
0078 If Month(Now()) > iEnd_Reporting_Month Then
0079 StrTitle_Month = StrTitle_Month & " - " & MonthName(iEnd_Reporting_Month)
0080 Else
0081 If Month(Now()) > iStart_Reporting_Month Then
0082 StrTitle_Month = StrTitle_Month & " - " & MonthName(Month(Now()))
0083 End If
0084 End If
0085 End If
0086 strNote_Period = StrTitle_Year & "_" & strNote_Period
0087Else
0088 strNote_Period = iReporting_Year
0089End If
0090 DoCmd.OpenQuery ("Time_This_Month_List_Update")
0091'Ready the Status_Tasklists table
0092 DoCmd.RunSQL ("DELETE Status_Tasklists.* FROM Status_Tasklists WHERE Status_Tasklists.Note_Period = """ & strNote_Period & """;")
0093 Set rsTableControl3 = CurrentDb.OpenRecordset("SELECT Status_Tasklists.* FROM Status_Tasklists WHERE Status_Tasklists.Note_ID = 0;")
0094'Read Note for update
0095 strLine = "SELECT Notes.* FROM Notes WHERE Notes.ID = " & Note_ID & ";"
0096Set rsTableControl = CurrentDb.OpenRecordset(strLine)
0097rsTableControl.MoveFirst
0098rsTableControl.Edit
0099'Re-create table for this quarter's tasks
0100 strLine = "Delete Time_This_Month_New.* FROM Time_This_Month_New;"
0101DoCmd.RunSQL (strLine)
0102 DoCmd.OpenQuery ("Time_This_Month_New_GEN")
0103If YTD = "No" Then
0104 strLine = "This is a list of the tasks performed on my various projects since my last [status report]++NP512++. It is automatically generated from my time-recording system, so is fairly crude. See also the [YTD Report]++1266++. For the latest list of Priority Tasks that I'm supposed to be working on, follow [this link]++1275++. The main purpose (for me) is to provide readily-available hyperlinks to what I've just written. Projects are in priority sequence, broken down by sub-project where appropriate. If the project name has a superscript, clicking on the name will take you to the last published report for this project. To jump to the Project task-lists, click on the links in the list below:-"
0105Else
0106 strLine = "This is a list of the tasks performed on my various projects since the beginning of the " & iReporting_Year & "-" & Right(iReporting_Year, 2) + 1 & " academic year. It is automatically generated from my time-recording system, so is fairly crude. See also the [Quarterly Report]++975++. This Annual Report is mostly for use for the ""inactive"" projects for which commented Quarterly Status reports are not produced. Projects are in priority sequence, broken down by sub-project where appropriate. If the project name has a superscript, clicking on the name will take you to the last published report for this project. To jump to the Project task-lists, click on the links in the list below:-"
0107End If
0108'Read the projects
0109 Set rsTableControl2 = CurrentDb.OpenRecordset("Select Projects.Project_Name FROM Projects WHERE Projects.Project_Name <> ""."" ORDER BY Projects.Priority;")
0110rsTableControl2.MoveFirst
0111i = 1
0112strLine = strLine & "|99|"
0113Do While Not rsTableControl2.EOF
0114 strLine = strLine & "|1|<A HREF = ""#Off-Page_Link_" & rsTableControl2.Fields(0) & """>" & rsTableControl2.Fields(0) & "</A>"
0115 If i = 1 Then
0116 strLine = strLine & " (For the latest Status Dashboard, [Click Here]++1024++)"
0117 i = 0
0118 End If
0119 rsTableControl2.MoveNext
0120Loop
0121If YTD = "No" Then
0122 strLine = strLine & "|1|<A HREF = ""#Off-Page_Link_Daily_Tasks"">Daily Tasks</A>"
0123End If
0124strLine = strLine & "|99|"
0125strLine = strLine & "Links to the latest time-analyses are given first. "
0126'Read the tasks
0127 Set rsTableControl2 = CurrentDb.OpenRecordset("Time_This_Month_New_Full")
0128Total_Time_outstanding_this_period = Nz(Round(rsTableControl2.Fields(8), 2))
0129rsTableControl2.MoveFirst
0130If rsTableControl2.Fields(0) = "." Then
0131 strLine = strLine & "|99|"
0132 strLine = strLine & IIf(Total_Time_outstanding_this_period & "" <> 0, "|1|Total Time <b>outstanding</b> this period = <b>" & rsTableControl2.Fields(8) & " hours</b>", "")
0133 strLine = strLine & "|1|[Click Here]++1005++ for Actual Detail Summary (2007 - " & strReporting_Year & ") by Sub-Project"
0134 strLine = strLine & "|1|[Click Here]++863++ for (by Project)|..||.|Summary of Effort YTD & QTD|.|Time Analysis (YTD by Study-location)|..|"
0135 strLine = strLine & "|1|[Click Here]++980++ for (by Project) |..||.|Plan versus Actual Effort Summary - Split (Previous Quarter & YTD)|.|Plan versus Actual Effort Summary - Actual (Previous Quarter & YTD)|.|Plan Summary (Next Quarter & Full Year)|.|Actual & Plan Summary (2007 - " & strReporting_Year & ")|..|"
0136 strLine = strLine & "|99|"
0137 rsTableControl2.MoveNext
0138End If
0139'Loop through projects & tasks
0140i = 0
0141ProjectSaved = "xxx"
0142Do Until rsTableControl2.EOF
0143 ProjectTemp = rsTableControl2.Fields(0)
0144 If ProjectTemp <> ProjectSaved Then
0145 'Finish off previous project
0146 If ProjectSaved = "xxx" Then
0147 Else
0148 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0149 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0150 Sub_Total = 0
0151 Paper_Saved = ""
0152 Else
0153 Sub_Total = 0
0154 Temp_Line = ""
0155 Paper_Saved = "" 'Added 15/04/2020
0156 End If
0157 Temp_Line = Temp_Line & "|..|"
0158 If Sub_projects = "Yes" Then
0159 Temp_Line = Temp_Line & "|II|"
0160 End If
0161 strLine = strLine & Temp_Line
0162 Status_Line = Status_Line & Temp_Line
0163 'Add the Status_Tasklists Row
0164 If rsTableControl2.Fields(11) & "" <> "" Then
0165 rsTableControl3.AddNew
0166 rsTableControl3.Fields(0) = Status_Project
0167 rsTableControl3.Fields(1) = strNote_Period
0168 rsTableControl3.Fields(2) = Now()
0169 rsTableControl3.Fields(3) = Status_Line
0170 rsTableControl3.Update
0171 End If
0172 End If
0173 'New Project
0174 i = i + 1
0175 Last_Paper_Displayed = "" 'Added 15/04/2020
0176 ProjectSaved = ProjectTemp
0177 Status_Project_Name = ProjectTemp
0178 strLine = strLine & "+R" & ProjectTemp & "R+ "
0179 If rsTableControl2.Fields(11) & "" <> "" Then
0180 Status_Line = ""
0181 Status_Project = rsTableControl2.Fields(11)
0182 ProjectTemp = ProjectTemp & "++" & rsTableControl2.Fields(11) & "++"
0183 End If
0184 If rsTableControl2.Fields(2) & "" = "" Or rsTableControl2.Fields(2) = rsTableControl2.Fields(8) Then
0185 strLine = strLine & "<b><u>Project " & i & ": " & ProjectTemp & "</u></b>"
0186 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b>"
0187 Else
0188 strLine = strLine & "<b><u>Project " & i & ": " & ProjectTemp & "</u></b> (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")"
0189 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b> (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")"
0190 End If
0191 'Sub-projects?
0192 If rsTableControl2.Fields(1) > 1 Then
0193 Sub_projects = "Yes"
0194 Sub_Project_Temp = rsTableControl2.Fields(3)
0195 Sub_Project_Saved = Sub_Project_Temp
0196 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0197 Temp_Line = "|II||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0198 Else
0199 Temp_Line = "|II||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & Round(rsTableControl2.Fields(4), 2) & ")|..|"
0200 End If
0201 If rsTableControl2.Fields(11) = 519 Then 'Add Bible-reading status for Religion
0202 Temp_Line = Temp_Line & Bible
0203 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 31 --> <!-- FUNCTOR_END ID=21 --> <br><br>"
0204 End If
0205 strLine = strLine & Temp_Line
0206 Status_Line = Status_Line & Temp_Line
0207 Else
0208 Sub_projects = "No"
0209 Temp_Line = "|..|"
0210 If rsTableControl2.Fields(11) = 519 Then 'Add bible-reading status for Religion
0211 Temp_Line = Temp_Line & Bible
0212 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 31 --> <!-- FUNCTOR_END ID=21 --> <br><br>"
0213 End If
0214 strLine = strLine & Temp_Line
0215 Status_Line = Status_Line & Temp_Line
0216 End If
0217 End If
0218 'New Sub-Project?
0219 If Sub_projects = "Yes" Then
0220 Sub_Project_Temp = rsTableControl2.Fields(3)
0221 If Sub_Project_Saved = Sub_Project_Temp Then
0222 Else
0223 'If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0224 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0225 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0226 Sub_Total = 0
0227 strLine = strLine & Temp_Line
0228 Status_Line = Status_Line & Temp_Line
0229 Paper_Saved = ""
0230 Else
0231 Sub_Total = 0
0232 End If
0233 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0234 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0235 Else
0236 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & Round(rsTableControl2.Fields(4), 2) & ")|..|"
0237 End If
0238 strLine = strLine & Temp_Line
0239 Status_Line = Status_Line & Temp_Line
0240 Sub_Project_Saved = Sub_Project_Temp
0241 End If
0242 End If
0243 'Task line
0244 If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0245 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0246 strLine = strLine & Temp_Line
0247 Status_Line = Status_Line & Temp_Line
0248 Sub_Total = 0
0249 Last_Paper_Displayed = Paper_Saved 'Added 22/02/20
0250 End If
0251 If rsTableControl2.Fields(8) & "" = "" Then
0252 Temp_Line = "|.|" & "No activity this period"
0253 Else
0254 'Check for Aeon
0255 If rsTableControl2.Fields(10) = "+P24006P+" Then
0256 'Check if read or not ....
0257 Aeon_FN = ""
0258 strAeon_WebRef = rsTableControl2.Fields(6)
0259 If InStr(strAeon_WebRef, "+W") > 0 Then
0260 strAeon_WebRef = Replace(strAeon_WebRef, "+", "")
0261 strAeon_WebRef = Replace(strAeon_WebRef, "W", "")
0262 Aeon_WebRef = Val(strAeon_WebRef)
0263 If Aeon_WebRef > 0 Then
0264 strQuery = "SELECT Aeon_Files.[Read?], Aeon_Files.WebRef_ID FROM Aeon_Files WHERE (((Aeon_Files.WebRef_ID)=" & Aeon_WebRef & "));"
0265 Set rsTableControl4 = CurrentDb.OpenRecordset(strQuery)
0266 If rsTableControl4.EOF Then
0267 Else
0268 rsTableControl4.MoveFirst
0269 If rsTableControl4.Fields(0) = True Then
0270 Aeon_FN = "FN"
0271 End If
0272 End If
0273 Set rsTableControl4 = Nothing
0274 End If
0275 Aeon_Link = "<a href =""../../Abstracts/Abstract_24/Abstract_24006.htm#Off-Page_Link_" & Aeon_FN & Replace(rsTableControl2.Fields(6), "+", "") & """>Comments</a>; "
0276 Else
0277 Aeon_Link = ""
0278 End If
0279 Else
0280 Aeon_Link = ""
0281 End If
0282 Temp_Line = "|.|" & IIf(rsTableControl2.Fields(9) = "T", rsTableControl2.Fields(6), IIf(rsTableControl2.Fields(12) = "P", rsTableControl2.Fields(10), rsTableControl2.Fields(5))) & " (" & Aeon_Link & IIf(rsTableControl2.Fields(7) & "" <> "", rsTableControl2.Fields(7) & ", ", "") & Round(rsTableControl2.Fields(8), 2) & " hour" & IIf(rsTableControl2.Fields(8) <> 1, "s", "") & ")"
0283 Paper_Saved = rsTableControl2.Fields(10) & ""
0284 If rsTableControl2.Fields(9) <> "T" Then
0285 Last_Paper_Displayed = Paper_Saved
0286 Else
0287 Sub_Total = Sub_Total + rsTableControl2.Fields(8)
0288 End If
0289 End If
0290 strLine = strLine & Temp_Line
0291 Status_Line = Status_Line & Temp_Line
0292 rsTableControl2.MoveNext
0293Loop
0294'Finish off last (sub-)project
0295If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0296 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0297Else
0298 Temp_Line = ""
0299End If
0300Temp_Line = Temp_Line & "|..|"
0301If Sub_projects = "Yes" Then
0302 Temp_Line = Temp_Line & "|II|"
0303End If
0304strLine = strLine & Temp_Line
0305Status_Line = Status_Line & Temp_Line
0306'Add the Daily Tasks table
0307If YTD = "No" Then
0308 Temp_Line = "+RDaily_TasksR+"
0309 Temp_Line = Temp_Line & "<hr><u>Appendix: Progress on Daily Tasks</u>"
0310 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 42, 1 --> <!-- FUNCTOR_END ID=21 -->"
0311 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 42, 2 --> <!-- FUNCTOR_END ID=21 -->"
0312 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 42, 3 --> <!-- FUNCTOR_END ID=21 -->"
0313' Temp_Line = Temp_Line & "|..||.|This reporting has been temporarily discontinued as the focus on these daily tasks is too distracting from more important matters."
0314' Temp_Line = Temp_Line & "|.|I still record time spent on these tasks, but the fulfilment of them is too spotty to be worth reporting. |..|"
0315 strLine = strLine & Temp_Line
0316End If
0317'Add the Status_Tasklists Row
0318rsTableControl3.AddNew
0319rsTableControl3.Fields(0) = Status_Project
0320rsTableControl3.Fields(1) = strNote_Period
0321rsTableControl3.Fields(2) = Now()
0322rsTableControl3.Fields(3) = Status_Line
0323rsTableControl3.Update
0324'Update Note
0325rsTableControl.Fields(3) = strLine
0326'Note Title
0327If YTD = "No" Then
0328 strLine = "Status: Summary Task List (" & StrTitle_Year & ": " & StrTitle_Month & ")"
0329Else
0330 If Right(strFile_Suffix, 2) = "Q4" Then
0331 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4)"
0332 Else
0333 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4 - " & strFile_Suffix & ")"
0334 End If
0335End If
0336rsTableControl.Fields(1) = strLine
0337'Set Note Status
0338rsTableControl.Fields(10) = "Temp"
0339rsTableControl.Update
0340'Output the note
0341 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0342 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0343rsTableControl.AddNew
0344rsTableControl.Fields(0) = Note_ID
0345rsTableControl.Update
0346Archive_Notes_Now = "No"
0347Regenerate_the_Links = "Yes"
0348Regen_Notes_Only = "Yes"
0349 CreateNotesWebPages
0350Set rsTableControl = Nothing
0351Set rsTableControl2 = Nothing
0352Set rsTableControl3 = Nothing
0353If automatic_processing = "Yes" Then
0354Else
0355 If YTD = "No" Then
0356 MsgBox ("This Quarter's Summary Task List (Note 975) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0357 Else
0358 MsgBox ("YTD Summary Task List (Note 1266) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0359 End If
0360End If
0361End Sub

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


© Theo Todman, June 2007 - March 2026. 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