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: 341
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. 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. I accidentally missed off a few books from the LXX, so had to extend the planned completion date by a Quarter. A period of Bridge crises saw me get further behind, so I've extended all three projects by a further quarter, which makes progress look more rosy than in reality."
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
0115strLine = strLine & "|99|"
0116strLine = strLine & "Links to the latest time-analyses are given first. "
0117'Read the tasks
0118 Set rsTableControl2 = CurrentDb.OpenRecordset("Time_This_Month_New_Full")
0119Total_Time_outstanding_this_period = Nz(Round(rsTableControl2.Fields(8), 2))
0120rsTableControl2.MoveFirst
0121If rsTableControl2.Fields(0) = "." Then
0122 strLine = strLine & "|99|"
0123 strLine = strLine & IIf(Total_Time_outstanding_this_period & "" <> 0, "|1|Total Time <b>outstanding</b> this period = <b>" & rsTableControl2.Fields(8) & " hours</b>", "")
0124 strLine = strLine & "|1|[Click Here]++1005++ for Actual Detail Summary (2007 - " & strReporting_Year & ") by Sub-Project"
0125 strLine = strLine & "|1|[Click Here]++863++ for (by Project)|..||.|Summary of Effort YTD & QTD|.|Time Analysis (YTD by Study-location)|..|"
0126 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 & ")|..|"
0127 strLine = strLine & "|99|"
0128 rsTableControl2.MoveNext
0129End If
0130'Loop through projects & tasks
0131i = 0
0132ProjectSaved = "xxx"
0133Do Until rsTableControl2.EOF
0134 ProjectTemp = rsTableControl2.Fields(0)
0135 If ProjectTemp <> ProjectSaved Then
0136 'Finish off previous project
0137 If ProjectSaved = "xxx" Then
0138 Else
0139 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0140 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0141 Sub_Total = 0
0142 Paper_Saved = ""
0143 Else
0144 Sub_Total = 0
0145 Temp_Line = ""
0146 Paper_Saved = "" 'Added 15/04/2020
0147 End If
0148 Temp_Line = Temp_Line & "|..|"
0149 If Sub_projects = "Yes" Then
0150 Temp_Line = Temp_Line & "|II|"
0151 End If
0152 strLine = strLine & Temp_Line
0153 Status_Line = Status_Line & Temp_Line
0154 'Add the Status_Tasklists Row
0155 If rsTableControl2.Fields(11) & "" <> "" Then
0156 rsTableControl3.AddNew
0157 rsTableControl3.Fields(0) = Status_Project
0158 rsTableControl3.Fields(1) = strNote_Period
0159 rsTableControl3.Fields(2) = Now()
0160 rsTableControl3.Fields(3) = Status_Line
0161 rsTableControl3.Update
0162 End If
0163 End If
0164 'New Project
0165 i = i + 1
0166 Last_Paper_Displayed = "" 'Added 15/04/2020
0167 ProjectSaved = ProjectTemp
0168 Status_Project_Name = ProjectTemp
0169 strLine = strLine & "+R" & ProjectTemp & "R+ "
0170 If rsTableControl2.Fields(11) & "" <> "" Then
0171 Status_Line = ""
0172 Status_Project = rsTableControl2.Fields(11)
0173 ProjectTemp = ProjectTemp & "++" & rsTableControl2.Fields(11) & "++"
0174 End If
0175 If rsTableControl2.Fields(2) & "" = "" Or rsTableControl2.Fields(2) = rsTableControl2.Fields(8) Then
0176 strLine = strLine & "<b><u>Project " & i & ": " & ProjectTemp & "</u></b>"
0177 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b>"
0178 Else
0179 strLine = strLine & "<b><u>Project " & i & ": " & ProjectTemp & "</u></b> (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")"
0180 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b> (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")"
0181 End If
0182 'Sub-projects?
0183 If rsTableControl2.Fields(1) > 1 Then
0184 Sub_projects = "Yes"
0185 Sub_Project_Temp = rsTableControl2.Fields(3)
0186 Sub_Project_Saved = Sub_Project_Temp
0187 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0188 Temp_Line = "|II||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0189 Else
0190 Temp_Line = "|II||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & Round(rsTableControl2.Fields(4), 2) & ")|..|"
0191 End If
0192 'If rsTableControl2.Fields(11) = 519 Then 'Add bible-reading status for Religion
0193 ' Temp_Line = Temp_Line & Bible
0194 ' Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 31 --> <!-- FUNCTOR_END ID=21 -->"
0195 'End If
0196 strLine = strLine & Temp_Line
0197 Status_Line = Status_Line & Temp_Line
0198 Else
0199 Sub_projects = "No"
0200 Temp_Line = "|..|"
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 -->"
0204 'End If
0205 strLine = strLine & Temp_Line
0206 Status_Line = Status_Line & Temp_Line
0207 End If
0208 End If
0209 'New Sub-Project?
0210 If Sub_projects = "Yes" Then
0211 Sub_Project_Temp = rsTableControl2.Fields(3)
0212 If Sub_Project_Saved = Sub_Project_Temp Then
0213 Else
0214 'If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0215 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0216 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0217 Sub_Total = 0
0218 strLine = strLine & Temp_Line
0219 Status_Line = Status_Line & Temp_Line
0220 Paper_Saved = ""
0221 Else
0222 Sub_Total = 0
0223 End If
0224 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0225 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0226 Else
0227 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & Round(rsTableControl2.Fields(4), 2) & ")|..|"
0228 End If
0229 strLine = strLine & Temp_Line
0230 Status_Line = Status_Line & Temp_Line
0231 Sub_Project_Saved = Sub_Project_Temp
0232 End If
0233 End If
0234 'Task line
0235 If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0236 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0237 strLine = strLine & Temp_Line
0238 Status_Line = Status_Line & Temp_Line
0239 Sub_Total = 0
0240 Last_Paper_Displayed = Paper_Saved 'Added 22/02/20
0241 End If
0242 If rsTableControl2.Fields(8) & "" = "" Then
0243 Temp_Line = "|.|" & "No activity this period"
0244 Else
0245 'Check for Aeon
0246 If rsTableControl2.Fields(10) = "+P24006P+" Then
0247 'Check if read or not ....
0248 Aeon_FN = ""
0249 strAeon_WebRef = rsTableControl2.Fields(6)
0250 If InStr(strAeon_WebRef, "+W") > 0 Then
0251 strAeon_WebRef = Replace(strAeon_WebRef, "+", "")
0252 strAeon_WebRef = Replace(strAeon_WebRef, "W", "")
0253 Aeon_WebRef = Val(strAeon_WebRef)
0254 If Aeon_WebRef > 0 Then
0255 strQuery = "SELECT Aeon_Files.[Read?], Aeon_Files.WebRef_ID FROM Aeon_Files WHERE (((Aeon_Files.WebRef_ID)=" & Aeon_WebRef & "));"
0256 Set rsTableControl4 = CurrentDb.OpenRecordset(strQuery)
0257 If rsTableControl4.EOF Then
0258 Else
0259 rsTableControl4.MoveFirst
0260 If rsTableControl4.Fields(0) = True Then
0261 Aeon_FN = "FN"
0262 End If
0263 End If
0264 Set rsTableControl4 = Nothing
0265 End If
0266 Aeon_Link = "<a href =""../../Abstracts/Abstract_24/Abstract_24006.htm#Off-Page_Link_" & Aeon_FN & Replace(rsTableControl2.Fields(6), "+", "") & """>Comments</a>; "
0267 Else
0268 Aeon_Link = ""
0269 End If
0270 Else
0271 Aeon_Link = ""
0272 End If
0273 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", "") & ")"
0274 Paper_Saved = rsTableControl2.Fields(10) & ""
0275 If rsTableControl2.Fields(9) <> "T" Then
0276 Last_Paper_Displayed = Paper_Saved
0277 Else
0278 Sub_Total = Sub_Total + rsTableControl2.Fields(8)
0279 End If
0280 End If
0281 strLine = strLine & Temp_Line
0282 Status_Line = Status_Line & Temp_Line
0283 rsTableControl2.MoveNext
0284Loop
0285'Finish off last (sub-)project
0286If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0287 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0288Else
0289 Temp_Line = ""
0290End If
0291Temp_Line = Temp_Line & "|..|"
0292If Sub_projects = "Yes" Then
0293 Temp_Line = Temp_Line & "|II|"
0294End If
0295strLine = strLine & Temp_Line
0296Status_Line = Status_Line & Temp_Line
0297'Add the Status_Tasklists Row
0298rsTableControl3.AddNew
0299rsTableControl3.Fields(0) = Status_Project
0300rsTableControl3.Fields(1) = strNote_Period
0301rsTableControl3.Fields(2) = Now()
0302rsTableControl3.Fields(3) = Status_Line
0303rsTableControl3.Update
0304'Update Note
0305rsTableControl.Fields(3) = strLine
0306'Note Title
0307If YTD = "No" Then
0308 strLine = "Status: Summary Task List (" & StrTitle_Year & ": " & StrTitle_Month & ")"
0309Else
0310 If Right(strFile_Suffix, 2) = "Q4" Then
0311 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4)"
0312 Else
0313 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4 - " & strFile_Suffix & ")"
0314 End If
0315End If
0316rsTableControl.Fields(1) = strLine
0317'Set Note Status
0318rsTableControl.Fields(10) = "Temp"
0319rsTableControl.Update
0320'Output the note
0321 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0322 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0323rsTableControl.AddNew
0324rsTableControl.Fields(0) = Note_ID
0325rsTableControl.Update
0326Archive_Notes_Now = "No"
0327Regenerate_the_Links = "Yes"
0328Regen_Notes_Only = "Yes"
0329 CreateNotesWebPages
0330Set rsTableControl = Nothing
0331Set rsTableControl2 = Nothing
0332Set rsTableControl3 = Nothing
0333If automatic_processing = "Yes" Then
0334Else
0335 If YTD = "No" Then
0336 MsgBox ("This Quarter's Summary Task List (Note 975) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0337 Else
0338 MsgBox ("YTD Summary Task List (Note 1266) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0339 End If
0340End If
0341End 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 - Sept 2023. 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