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