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: 353
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
0031Const Bible = "|.|Below is a table showing the progress on my project to read the OT, LXX & NT in the original Hebrew and Greek. |ii||1|I'm on my second pass through the NT. I've also read through the Koran, but mostly in English. One day in Arabic, maybe. |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. |1|We'll see how it goes! |ii|<br>"
0032Start_Time = Now()
0033If YTD = "No" Then
0034 Note_ID = 975
0035Else
0036 Note_ID = 1266
0037End If
0038'Determine the Parameters
0039 Set rsTableControl2 = CurrentDb.OpenRecordset("SELECT Next_Reporting_Month.* FROM Next_Reporting_Month;")
0040'Determine File Suffix
0041rsTableControl2.MoveFirst
0042strFile_Suffix = rsTableControl2.Fields(8)
0043iStart_Reporting_Month = rsTableControl2.Fields(1)
0044iEnd_Reporting_Month = rsTableControl2.Fields(2)
0045iReporting_Year = rsTableControl2.Fields(5) ' .... Start Year
0046strReporting_Year = iReporting_Year
0047If iEnd_Reporting_Month < 10 Then
0048 If YTD = "No" Then
0049 iReporting_Year = iReporting_Year + 1
0050 End If
0051 strReporting_Year = iReporting_Year + 1
0052End If
0053'Determine the Title year & months ...
0054If YTD = "No" Then
0055 If iEnd_Reporting_Month = 12 And Month(Now()) < 4 Then
0056 StrTitle_Year = Year(Now()) - 1
0057 StrTitle_Month = MonthName(iStart_Reporting_Month) & " - December"
0058 strNote_Period = "Q4"
0059 Else
0060 Select Case iStart_Reporting_Month
0061 Case 1
0062 strNote_Period = "Q1"
0063 Case 4
0064 strNote_Period = "Q2"
0065 Case 7
0066 strNote_Period = "Q3"
0067 Case 10
0068 strNote_Period = "Q4"
0069 End Select
0070 StrTitle_Year = Year(Now())
0071 StrTitle_Month = MonthName(iStart_Reporting_Month)
0072 If Month(Now()) > iEnd_Reporting_Month Then
0073 StrTitle_Month = StrTitle_Month & " - " & MonthName(iEnd_Reporting_Month)
0074 Else
0075 If Month(Now()) > iStart_Reporting_Month Then
0076 StrTitle_Month = StrTitle_Month & " - " & MonthName(Month(Now()))
0077 End If
0078 End If
0079 End If
0080 strNote_Period = StrTitle_Year & "_" & strNote_Period
0081Else
0082 strNote_Period = iReporting_Year
0083End If
0084 DoCmd.OpenQuery ("Time_This_Month_List_Update")
0085'Ready the Status_Tasklists table
0086 DoCmd.RunSQL ("DELETE Status_Tasklists.* FROM Status_Tasklists WHERE Status_Tasklists.Note_Period = """ & strNote_Period & """;")
0087 Set rsTableControl3 = CurrentDb.OpenRecordset("SELECT Status_Tasklists.* FROM Status_Tasklists WHERE Status_Tasklists.Note_ID = 0;")
0088'Read Note for update
0089 strLine = "SELECT Notes.* FROM Notes WHERE Notes.ID = " & Note_ID & ";"
0090Set rsTableControl = CurrentDb.OpenRecordset(strLine)
0091rsTableControl.MoveFirst
0092rsTableControl.Edit
0093'Re-create table for this quarter's tasks
0094 strLine = "Delete Time_This_Month_New.* FROM Time_This_Month_New;"
0095DoCmd.RunSQL (strLine)
0096 DoCmd.OpenQuery ("Time_This_Month_New_GEN")
0097If YTD = "No" Then
0098 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:-"
0099Else
0100 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:-"
0101End If
0102'Read the projects
0103 Set rsTableControl2 = CurrentDb.OpenRecordset("Select Projects.Project_Name FROM Projects WHERE Projects.Project_Name <> ""."" ORDER BY Projects.Priority;")
0104rsTableControl2.MoveFirst
0105i = 1
0106strLine = strLine & "|99|"
0107Do While Not rsTableControl2.EOF
0108 strLine = strLine & "|1|<A HREF = ""#Off-Page_Link_" & rsTableControl2.Fields(0) & """>" & rsTableControl2.Fields(0) & "</A>"
0109 If i = 1 Then
0110 strLine = strLine & " (For the latest Status Dashboard, [Click Here]++1024++)"
0111 i = 0
0112 End If
0113 rsTableControl2.MoveNext
0114Loop
0115If YTD = "No" Then
0116 strLine = strLine & "|1|<A HREF = ""#Off-Page_Link_Daily_Tasks"">Daily Tasks</A>"
0117End If
0118strLine = strLine & "|99|"
0119strLine = strLine & "Links to the latest time-analyses are given first. "
0120'Read the tasks
0121 Set rsTableControl2 = CurrentDb.OpenRecordset("Time_This_Month_New_Full")
0122Total_Time_outstanding_this_period = Nz(Round(rsTableControl2.Fields(8), 2))
0123rsTableControl2.MoveFirst
0124If rsTableControl2.Fields(0) = "." Then
0125 strLine = strLine & "|99|"
0126 strLine = strLine & IIf(Total_Time_outstanding_this_period & "" <> 0, "|1|Total Time <b>outstanding</b> this period = <b>" & rsTableControl2.Fields(8) & " hours</b>", "")
0127 strLine = strLine & "|1|[Click Here]++1005++ for Actual Detail Summary (2007 - " & strReporting_Year & ") by Sub-Project"
0128 strLine = strLine & "|1|[Click Here]++863++ for (by Project)|..||.|Summary of Effort YTD & QTD|.|Time Analysis (YTD by Study-location)|..|"
0129 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 & ")|..|"
0130 strLine = strLine & "|99|"
0131 rsTableControl2.MoveNext
0132End If
0133'Loop through projects & tasks
0134i = 0
0135ProjectSaved = "xxx"
0136Do Until rsTableControl2.EOF
0137 ProjectTemp = rsTableControl2.Fields(0)
0138 If ProjectTemp <> ProjectSaved Then
0139 'Finish off previous project
0140 If ProjectSaved = "xxx" Then
0141 Else
0142 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0143 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0144 Sub_Total = 0
0145 Paper_Saved = ""
0146 Else
0147 Sub_Total = 0
0148 Temp_Line = ""
0149 Paper_Saved = "" 'Added 15/04/2020
0150 End If
0151 Temp_Line = Temp_Line & "|..|"
0152 If Sub_projects = "Yes" Then
0153 Temp_Line = Temp_Line & "|II|"
0154 End If
0155 strLine = strLine & Temp_Line
0156 Status_Line = Status_Line & Temp_Line
0157 'Add the Status_Tasklists Row
0158 If rsTableControl2.Fields(11) & "" <> "" Then
0159 rsTableControl3.AddNew
0160 rsTableControl3.Fields(0) = Status_Project
0161 rsTableControl3.Fields(1) = strNote_Period
0162 rsTableControl3.Fields(2) = Now()
0163 rsTableControl3.Fields(3) = Status_Line
0164 rsTableControl3.Update
0165 End If
0166 End If
0167 'New Project
0168 i = i + 1
0169 Last_Paper_Displayed = "" 'Added 15/04/2020
0170 ProjectSaved = ProjectTemp
0171 Status_Project_Name = ProjectTemp
0172 strLine = strLine & "+R" & ProjectTemp & "R+ "
0173 If rsTableControl2.Fields(11) & "" <> "" Then
0174 Status_Line = ""
0175 Status_Project = rsTableControl2.Fields(11)
0176 ProjectTemp = ProjectTemp & "++" & rsTableControl2.Fields(11) & "++"
0177 End If
0178 If rsTableControl2.Fields(2) & "" = "" Or rsTableControl2.Fields(2) = rsTableControl2.Fields(8) Then
0179 strLine = strLine & "<b><u>Project " & i & ": " & ProjectTemp & "</u></b>"
0180 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b>"
0181 Else
0182 strLine = strLine & "<b><u>Project " & i & ": " & ProjectTemp & "</u></b> (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")"
0183 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b> (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")"
0184 End If
0185 'Sub-projects?
0186 If rsTableControl2.Fields(1) > 1 Then
0187 Sub_projects = "Yes"
0188 Sub_Project_Temp = rsTableControl2.Fields(3)
0189 Sub_Project_Saved = Sub_Project_Temp
0190 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0191 Temp_Line = "|II||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0192 Else
0193 Temp_Line = "|II||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & Round(rsTableControl2.Fields(4), 2) & ")|..|"
0194 End If
0195 If rsTableControl2.Fields(11) = 519 Then 'Add bible-reading status for Religion
0196 Temp_Line = Temp_Line & Bible
0197 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 31 --> <!-- FUNCTOR_END ID=21 --> <br><br>"
0198 End If
0199 strLine = strLine & Temp_Line
0200 Status_Line = Status_Line & Temp_Line
0201 Else
0202 Sub_projects = "No"
0203 Temp_Line = "|..|"
0204 If rsTableControl2.Fields(11) = 519 Then 'Add bible-reading status for Religion
0205 Temp_Line = Temp_Line & Bible
0206 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 31 --> <!-- FUNCTOR_END ID=21 --> <br><br>"
0207 End If
0208 strLine = strLine & Temp_Line
0209 Status_Line = Status_Line & Temp_Line
0210 End If
0211 End If
0212 'New Sub-Project?
0213 If Sub_projects = "Yes" Then
0214 Sub_Project_Temp = rsTableControl2.Fields(3)
0215 If Sub_Project_Saved = Sub_Project_Temp Then
0216 Else
0217 'If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0218 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0219 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0220 Sub_Total = 0
0221 strLine = strLine & Temp_Line
0222 Status_Line = Status_Line & Temp_Line
0223 Paper_Saved = ""
0224 Else
0225 Sub_Total = 0
0226 End If
0227 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0228 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0229 Else
0230 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & Round(rsTableControl2.Fields(4), 2) & ")|..|"
0231 End If
0232 strLine = strLine & Temp_Line
0233 Status_Line = Status_Line & Temp_Line
0234 Sub_Project_Saved = Sub_Project_Temp
0235 End If
0236 End If
0237 'Task line
0238 If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0239 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0240 strLine = strLine & Temp_Line
0241 Status_Line = Status_Line & Temp_Line
0242 Sub_Total = 0
0243 Last_Paper_Displayed = Paper_Saved 'Added 22/02/20
0244 End If
0245 If rsTableControl2.Fields(8) & "" = "" Then
0246 Temp_Line = "|.|" & "No activity this period"
0247 Else
0248 'Check for Aeon
0249 If rsTableControl2.Fields(10) = "+P24006P+" Then
0250 'Check if read or not ....
0251 Aeon_FN = ""
0252 strAeon_WebRef = rsTableControl2.Fields(6)
0253 If InStr(strAeon_WebRef, "+W") > 0 Then
0254 strAeon_WebRef = Replace(strAeon_WebRef, "+", "")
0255 strAeon_WebRef = Replace(strAeon_WebRef, "W", "")
0256 Aeon_WebRef = Val(strAeon_WebRef)
0257 If Aeon_WebRef > 0 Then
0258 strQuery = "SELECT Aeon_Files.[Read?], Aeon_Files.WebRef_ID FROM Aeon_Files WHERE (((Aeon_Files.WebRef_ID)=" & Aeon_WebRef & "));"
0259 Set rsTableControl4 = CurrentDb.OpenRecordset(strQuery)
0260 If rsTableControl4.EOF Then
0261 Else
0262 rsTableControl4.MoveFirst
0263 If rsTableControl4.Fields(0) = True Then
0264 Aeon_FN = "FN"
0265 End If
0266 End If
0267 Set rsTableControl4 = Nothing
0268 End If
0269 Aeon_Link = "<a href =""../../Abstracts/Abstract_24/Abstract_24006.htm#Off-Page_Link_" & Aeon_FN & Replace(rsTableControl2.Fields(6), "+", "") & """>Comments</a>; "
0270 Else
0271 Aeon_Link = ""
0272 End If
0273 Else
0274 Aeon_Link = ""
0275 End If
0276 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", "") & ")"
0277 Paper_Saved = rsTableControl2.Fields(10) & ""
0278 If rsTableControl2.Fields(9) <> "T" Then
0279 Last_Paper_Displayed = Paper_Saved
0280 Else
0281 Sub_Total = Sub_Total + rsTableControl2.Fields(8)
0282 End If
0283 End If
0284 strLine = strLine & Temp_Line
0285 Status_Line = Status_Line & Temp_Line
0286 rsTableControl2.MoveNext
0287Loop
0288'Finish off last (sub-)project
0289If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0290 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0291Else
0292 Temp_Line = ""
0293End If
0294Temp_Line = Temp_Line & "|..|"
0295If Sub_projects = "Yes" Then
0296 Temp_Line = Temp_Line & "|II|"
0297End If
0298strLine = strLine & Temp_Line
0299Status_Line = Status_Line & Temp_Line
0300'Add the Daily Tasks table
0301If YTD = "No" Then
0302 Temp_Line = "+RDaily_TasksR+"
0303 Temp_Line = Temp_Line & "<hr><u>Appendix: Progress on Daily Tasks</u>"
0304 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 42, 1 --> <!-- FUNCTOR_END ID=21 -->"
0305 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 42, 2 --> <!-- FUNCTOR_END ID=21 -->"
0306 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 42, 3 --> <!-- FUNCTOR_END ID=21 -->"
0307 strLine = strLine & Temp_Line
0308End If
0309'Add the Status_Tasklists Row
0310rsTableControl3.AddNew
0311rsTableControl3.Fields(0) = Status_Project
0312rsTableControl3.Fields(1) = strNote_Period
0313rsTableControl3.Fields(2) = Now()
0314rsTableControl3.Fields(3) = Status_Line
0315rsTableControl3.Update
0316'Update Note
0317rsTableControl.Fields(3) = strLine
0318'Note Title
0319If YTD = "No" Then
0320 strLine = "Status: Summary Task List (" & StrTitle_Year & ": " & StrTitle_Month & ")"
0321Else
0322 If Right(strFile_Suffix, 2) = "Q4" Then
0323 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4)"
0324 Else
0325 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4 - " & strFile_Suffix & ")"
0326 End If
0327End If
0328rsTableControl.Fields(1) = strLine
0329'Set Note Status
0330rsTableControl.Fields(10) = "Temp"
0331rsTableControl.Update
0332'Output the note
0333 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0334 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0335rsTableControl.AddNew
0336rsTableControl.Fields(0) = Note_ID
0337rsTableControl.Update
0338Archive_Notes_Now = "No"
0339Regenerate_the_Links = "Yes"
0340Regen_Notes_Only = "Yes"
0341 CreateNotesWebPages
0342Set rsTableControl = Nothing
0343Set rsTableControl2 = Nothing
0344Set rsTableControl3 = Nothing
0345If automatic_processing = "Yes" Then
0346Else
0347 If YTD = "No" Then
0348 MsgBox ("This Quarter's Summary Task List (Note 975) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0349 Else
0350 MsgBox ("YTD Summary Task List (Note 1266) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0351 End If
0352End If
0353End 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 - 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