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: 333
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 <> rsTableControl2.Fields(10) & "" And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
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 = " & rsTableControl2.Fields(2) & ")"
0180 Status_Line = Status_Line & "<b><u>" & Status_Project_Name & "</u></b> (Total Hours = " & rsTableControl2.Fields(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 = " & rsTableControl2.Fields(4) & ")|..|"
0191 End If
0192 strLine = strLine & Temp_Line
0193 Status_Line = Status_Line & Temp_Line
0194 Else
0195 Sub_projects = "No"
0196 Temp_Line = "|..|"
0197 If rsTableControl2.Fields(11) = 519 Then 'Add bible-reading status for Religion
0198 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. "
0199 Temp_Line = Temp_Line & "<!-- FUNCTOR_ID=21, 31 --> <!-- FUNCTOR_END ID=21 -->"
0200 End If
0201 strLine = strLine & Temp_Line
0202 Status_Line = Status_Line & Temp_Line
0203 End If
0204 End If
0205 'New Sub-Project?
0206 If Sub_projects = "Yes" Then
0207 Sub_Project_Temp = rsTableControl2.Fields(3)
0208 If Sub_Project_Saved = Sub_Project_Temp Then
0209 Else
0210 'If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0211 If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0212 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0213 Sub_Total = 0
0214 strLine = strLine & Temp_Line
0215 Status_Line = Status_Line & Temp_Line
0216 Paper_Saved = ""
0217 Else
0218 Sub_Total = 0
0219 End If
0220 If rsTableControl2.Fields(4) = rsTableControl2.Fields(8) Then
0221 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b>|..|"
0222 Else
0223 Temp_Line = "|..||1|<b>" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "</b> (Total Hours = " & rsTableControl2.Fields(4) & ")|..|"
0224 End If
0225 strLine = strLine & Temp_Line
0226 Status_Line = Status_Line & Temp_Line
0227 Sub_Project_Saved = Sub_Project_Temp
0228 End If
0229 End If
0230 'Task line
0231 If Paper_Saved <> rsTableControl2.Fields(10) And Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0232 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0233 strLine = strLine & Temp_Line
0234 Status_Line = Status_Line & Temp_Line
0235 Sub_Total = 0
0236 Last_Paper_Displayed = Paper_Saved 'Added 22/02/20
0237 End If
0238 If rsTableControl2.Fields(8) & "" = "" Then
0239 Temp_Line = "|.|" & "No activity this period"
0240 Else
0241 'Check for Aeon
0242 If rsTableControl2.Fields(10) = "+P24006P+" Then
0243 'Check if read or not ....
0244 Aeon_FN = ""
0245 strAeon_WebRef = rsTableControl2.Fields(6)
0246 strAeon_WebRef = Replace(strAeon_WebRef, "+", "")
0247 strAeon_WebRef = Replace(strAeon_WebRef, "W", "")
0248 Aeon_WebRef = Val(strAeon_WebRef)
0249 If Aeon_WebRef > 0 Then
0250 strQuery = "SELECT Aeon_Files.[Read?], Aeon_Files.WebRef_ID FROM Aeon_Files WHERE (((Aeon_Files.WebRef_ID)=" & Aeon_WebRef & "));"
0251 Set rsTableControl4 = CurrentDb.OpenRecordset(strQuery)
0252 If rsTableControl4.EOF Then
0253 Else
0254 rsTableControl4.MoveFirst
0255 If rsTableControl4.Fields(0) = True Then
0256 Aeon_FN = "FN"
0257 End If
0258 End If
0259 Set rsTableControl4 = Nothing
0260 End If
0261 Aeon_Link = "<a href =""../../Abstracts/Abstract_24/Abstract_24006.htm#Off-Page_Link_" & Aeon_FN & Replace(rsTableControl2.Fields(6), "+", "") & """>Comments</a>; "
0262 Else
0263 Aeon_Link = ""
0264 End If
0265 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) & ", ", "") & rsTableControl2.Fields(8) & " hour" & IIf(rsTableControl2.Fields(8) <> 1, "s", "") & ")"
0266 Paper_Saved = rsTableControl2.Fields(10) & ""
0267 If rsTableControl2.Fields(9) <> "T" Then
0268 Last_Paper_Displayed = Paper_Saved
0269 Else
0270 Sub_Total = Sub_Total + rsTableControl2.Fields(8)
0271 End If
0272 End If
0273 strLine = strLine & Temp_Line
0274 Status_Line = Status_Line & Temp_Line
0275 rsTableControl2.MoveNext
0276Loop
0277'Finish off last (sub-)project
0278If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then
0279 Temp_Line = "<br>&rarr; See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")"
0280Else
0281 Temp_Line = ""
0282End If
0283Temp_Line = Temp_Line & "|..|"
0284If Sub_projects = "Yes" Then
0285 Temp_Line = Temp_Line & "|II|"
0286End If
0287strLine = strLine & Temp_Line
0288Status_Line = Status_Line & Temp_Line
0289'Add the Status_Tasklists Row
0290rsTableControl3.AddNew
0291rsTableControl3.Fields(0) = Status_Project
0292rsTableControl3.Fields(1) = strNote_Period
0293rsTableControl3.Fields(2) = Now()
0294rsTableControl3.Fields(3) = Status_Line
0295rsTableControl3.Update
0296'Update Note
0297rsTableControl.Fields(3) = strLine
0298'Note Title
0299If YTD = "No" Then
0300 strLine = "Status: Summary Task List (" & StrTitle_Year & ": " & StrTitle_Month & ")"
0301Else
0302 If Right(strFile_Suffix, 2) = "Q4" Then
0303 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4)"
0304 Else
0305 strLine = "Status: Summary Task List (YTD: " & Right(iReporting_Year, 2) & "Q4 - " & strFile_Suffix & ")"
0306 End If
0307End If
0308rsTableControl.Fields(1) = strLine
0309'Set Note Status
0310rsTableControl.Fields(10) = "Temp"
0311rsTableControl.Update
0312'Output the note
0313 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0314 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0315rsTableControl.AddNew
0316rsTableControl.Fields(0) = Note_ID
0317rsTableControl.Update
0318Archive_Notes_Now = "No"
0319Regenerate_the_Links = "Yes"
0320Regen_Notes_Only = "Yes"
0321 CreateNotesWebPages
0322Set rsTableControl = Nothing
0323Set rsTableControl2 = Nothing
0324Set rsTableControl3 = Nothing
0325If automatic_processing = "Yes" Then
0326Else
0327 If YTD = "No" Then
0328 MsgBox ("This Quarter's Summary Task List (Note 975) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0329 Else
0330 MsgBox ("YTD Summary Task List (Note 1266) output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0331 End If
0332End If
0333End 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 - Jan 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