Line-No. / Ref. | Code Line |
0001 | Public Sub CreateCodeWebpages() |
0002 | Dim rsTableControl As Recordset |
0003 | Dim strControlQuery As String |
0004 | Dim strLine As String |
0005 | Dim iTableColumns As Integer |
0006 | Dim i As Long |
0007 | Dim strFileSuffix As String |
0008 | Dim strFileBody As String |
0009 | Dim Procedure_Type As String |
0010 | Dim Heading As String |
0011 | Dim rsTableToRead As Recordset |
0012 | Dim rsTableToRead2 As Recordset |
0013 | Dim Procedure_Location As Integer |
0014 | Dim Procedure_Location_Saved As Integer |
0015 | Dim This_Location As Integer |
0016 | Dim This_Object As String |
0017 | Dim This_Object_Type As String |
0018 | Dim This_Object_Count As String |
0019 | Dim This_Line As Integer |
0020 | Dim Last_Location As Integer |
0021 | Dim Last_Object As String |
0022 | Dim Last_Object_Type As String |
0023 | Dim Last_Line As Integer |
0024 | Dim 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;" |
0028 | Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery) |
0029 | rsTableToRead.MoveFirst |
0030 | Procedure_Location = rsTableToRead.Fields(2) |
0031 | Procedure_Location_Saved = Procedure_Location |
0032 | 'Create First File |
0033 | strOutputFileShort = SubSystem & "Documentation_Code_" & Procedure_Location |
0034 | Set 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;" |
0037 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0038 | rsTableControl.MoveFirst |
0039 | Do While Not rsTableControl.EOF |
0040 | strLine = rsTableControl.Fields(0) & "" |
0041 | tsTextFile.WriteLine strLine |
0042 | rsTableControl.MoveNext |
0043 | Loop |
0044 | Procedure_Location = rsTableToRead.Fields(2) |
0045 | 'Create Jump Table |
0046 | iTableColumns = 4 |
0047 | Procedure_Type = "Location" |
0048 | Heading = "Code Documentation Location " & Procedure_Location |
0049 | OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location) |
0050 | Do 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 = "
" |
0090 | tsTextFile.WriteLine strLine |
0091 | Heading = rsTableToRead.Fields(1) |
0092 | strLine = "" & "Source Code of: " & Heading & " " |
0093 | strLine = strLine & "Procedure Type: " & rsTableToRead.Fields(0) & " " |
0094 | strLine = strLine & "Module: " & rsTableToRead.Fields(5) & " " |
0095 | strLine = strLine & "Lines of Code: " & rsTableToRead.Fields(6) & " " |
0096 | tsTextFile.WriteLine strLine |
0097 | 'Create link to bottom of Procedure |
0098 | If rsTableToRead.Fields(6) > 20 Then |
0099 | strLine = "Go To End of This Procedure " |
0100 | Else |
0101 | strLine = " " |
0102 | End If |
0103 | tsTextFile.WriteLine strLine |
0104 | OK = Parse_Code_To_Wepage(rsTableToRead.Fields(4)) |
0105 | strLine = "" |
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 = "Procedures Calling This Procedure (" & Heading & ") |
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 = "" & Last_Object & " (From Lines " & "" & Last_Line & ", " |
0124 | Else |
0125 | strLine = strLine & "" & Last_Line & ", " |
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 = "" & Last_Object & " (From Line " & Last_Line & ")" |
0132 | Else |
0133 | strLine = strLine & "" & Last_Line & ")" |
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 = "" & Last_Object & " (From Line " & Last_Line & ")" |
0148 | Else |
0149 | strLine = strLine & "" & Last_Line & ")" |
0150 | End If |
0151 | tsTextFile.WriteLine strLine |
0152 | End If |
0153 | strLine = "" |
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 = "Procedures Called By This Procedure (" & Heading & ") |
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 = "" & Last_Object & " (From Lines " & Last_Line & ", " |
0173 | Else |
0174 | strLine = strLine & "" & Last_Line & ", " |
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 = "" & Last_Object & " (From Line " & Last_Line & ")" |
0181 | Else |
0182 | strLine = strLine & "" & Last_Line & ")" |
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 = "" & Last_Object & " (From Line " & Last_Line & ")" |
0197 | Else |
0198 | strLine = strLine & "" & Last_Line & ")" |
0199 | End If |
0200 | tsTextFile.WriteLine strLine |
0201 | End If |
0202 | strLine = "" |
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 = "Tables / Queries / Fragments Directly Used By This Procedure (" & Heading & ") |
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 = "" & Last_Object & " (Query, used in Lines " & Last_Line & ", " |
0228 | Else |
0229 | If Last_Object_Type = "T" Then |
0230 | strLine = "" & Last_Object & " (Table, used in Lines " & Last_Line & ", " |
0231 | Else |
0232 | strLine = "" & Last_Object & " (Query Fragment, used in Lines " & Last_Line & ", " |
0233 | End If |
0234 | End If |
0235 | Else |
0236 | strLine = strLine & "" & Last_Line & ", " |
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 = "" & Last_Object & " (Query, used in Line " & Last_Line & ")" |
0244 | Else |
0245 | If Last_Object_Type = "T" Then |
0246 | strLine = "" & Last_Object & " (Table, used in Line " & Last_Line & ")" |
0247 | Else |
0248 | strLine = "" & Last_Object & " (Query Fragment, used in Line " & Last_Line & ")" |
0249 | End If |
0250 | End If |
0251 | Else |
0252 | strLine = strLine & "" & Last_Line & ")" |
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 = "" & Last_Object & " (Query, used in Line " & Last_Line & ")" |
0269 | Else |
0270 | If Last_Object_Type = "T" Then |
0271 | strLine = "" & Last_Object & " (Table, used in Line " & Last_Line & ")" |
0272 | Else |
0273 | strLine = "" & Last_Object & " (Query Fragment, used in Line " & Last_Line & ")" |
0274 | End If |
0275 | End If |
0276 | Else |
0277 | strLine = strLine & "" & Last_Line & ")" |
0278 | End If |
0279 | tsTextFile.WriteLine strLine |
0280 | End If |
0281 | strLine = "" |
0282 | tsTextFile.WriteLine strLine |
0283 | End If |
0284 | 'Create link to top of Procedure |
0285 | If rsTableToRead.Fields(6) > 20 Then |
0286 | strLine = "Go To Start of This Procedure " |
0287 | tsTextFile.WriteLine strLine |
0288 | End If |
0289 | 'Create link to top of page |
0290 | strLine = "Go To Top of This Page " |
0291 | tsTextFile.WriteLine strLine |
0292 | 'Create link to main code jump-table |
0293 | strLine = "Link to VBA Code Control Page " |
0294 | tsTextFile.WriteLine strLine |
0295 | rsTableToRead.MoveNext |
0296 | Loop |
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;" |
0300 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0301 | rsTableControl.MoveFirst |
0302 | Do While Not rsTableControl.EOF |
0303 | Time_Stamp = rsTableControl.Fields(0) & "" |
0304 | OK = Replace_Timestamp(Time_Stamp) |
0305 | tsTextFile.WriteLine Time_Stamp |
0306 | rsTableControl.MoveNext |
0307 | Loop |
0308 | 'Copy to Transfer |
0309 | strFileSuffix = strOutputFileShort |
0310 | OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm") |
0311 | Set tsTextFile = Nothing |
0312 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Monthly_Report_Note975_Update(YTD) |
0002 | 'This Sub now produces both the Quarterly Note (975) and the Annual Note (1266) |
0003 | Dim Start_Time As Date |
0004 | Dim strLine As String |
0005 | Dim rsTableControl As Recordset |
0006 | Dim rsTableControl2 As Recordset |
0007 | Dim rsTableControl3 As Recordset |
0008 | Dim rsTableControl4 As Recordset |
0009 | Dim i As Integer |
0010 | Dim ProjectSaved As String |
0011 | Dim ProjectTemp As String |
0012 | Dim Sub_projects As String |
0013 | Dim Sub_Project_Temp As String |
0014 | Dim Sub_Project_Saved As String |
0015 | Dim Paper_Saved As String |
0016 | Dim Last_Paper_Displayed As String |
0017 | Dim Status_Project As Integer |
0018 | Dim Status_Line As String |
0019 | Dim Temp_Line As String |
0020 | Dim strNote_Period As String |
0021 | Dim Status_Project_Name As String |
0022 | Dim Note_ID As Integer |
0023 | Dim strReporting_Year As String |
0024 | Dim Total_Time_outstanding_this_period As Single |
0025 | Dim Sub_Total As Single |
0026 | Dim Aeon_Link As String |
0027 | Dim strQuery As String |
0028 | Dim Aeon_FN As String |
0029 | Dim strAeon_WebRef As String |
0030 | Dim Aeon_WebRef As Integer |
0031 | Const 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." |
0032 | Start_Time = Now() |
0033 | If YTD = "No" Then |
0034 | Note_ID = 975 |
0035 | Else |
0036 | Note_ID = 1266 |
0037 | End If |
0038 | 'Determine the Parameters |
0039 | Set rsTableControl2 = CurrentDb.OpenRecordset("SELECT Next_Reporting_Month.* FROM Next_Reporting_Month;") |
0040 | 'Determine File Suffix |
0041 | rsTableControl2.MoveFirst |
0042 | strFile_Suffix = rsTableControl2.Fields(8) |
0043 | iStart_Reporting_Month = rsTableControl2.Fields(1) |
0044 | iEnd_Reporting_Month = rsTableControl2.Fields(2) |
0045 | iReporting_Year = rsTableControl2.Fields(5) ' .... Start Year |
0046 | strReporting_Year = iReporting_Year |
0047 | If 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 |
0052 | End If |
0053 | 'Determine the Title year & months ... |
0054 | If 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 |
0081 | Else |
0082 | strNote_Period = iReporting_Year |
0083 | End 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 & ";" |
0090 | Set rsTableControl = CurrentDb.OpenRecordset(strLine) |
0091 | rsTableControl.MoveFirst |
0092 | rsTableControl.Edit |
0093 | 'Re-create table for this quarter's tasks |
0094 | strLine = "Delete Time_This_Month_New.* FROM Time_This_Month_New;" |
0095 | DoCmd.RunSQL (strLine) |
0096 | DoCmd.OpenQuery ("Time_This_Month_New_GEN") |
0097 | If 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:-" |
0099 | Else |
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:-" |
0101 | End If |
0102 | 'Read the projects |
0103 | Set rsTableControl2 = CurrentDb.OpenRecordset("Select Projects.Project_Name FROM Projects WHERE Projects.Project_Name <> ""."" ORDER BY Projects.Priority;") |
0104 | rsTableControl2.MoveFirst |
0105 | i = 1 |
0106 | strLine = strLine & "|99|" |
0107 | Do While Not rsTableControl2.EOF |
0108 | strLine = strLine & "|1|" & rsTableControl2.Fields(0) & "" |
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 |
0114 | Loop |
0115 | strLine = strLine & "|99|" |
0116 | strLine = strLine & "Links to the latest time-analyses are given first. " |
0117 | 'Read the tasks |
0118 | Set rsTableControl2 = CurrentDb.OpenRecordset("Time_This_Month_New_Full") |
0119 | Total_Time_outstanding_this_period = Nz(Round(rsTableControl2.Fields(8), 2)) |
0120 | rsTableControl2.MoveFirst |
0121 | If rsTableControl2.Fields(0) = "." Then |
0122 | strLine = strLine & "|99|" |
0123 | strLine = strLine & IIf(Total_Time_outstanding_this_period & "" <> 0, "|1|Total Time outstanding this period = " & rsTableControl2.Fields(8) & " hours", "") |
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 |
0129 | End If |
0130 | 'Loop through projects & tasks |
0131 | i = 0 |
0132 | ProjectSaved = "xxx" |
0133 | Do 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 = " → 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 & "Project " & i & ": " & ProjectTemp & "" |
0177 | Status_Line = Status_Line & "" & Status_Project_Name & "" |
0178 | Else |
0179 | strLine = strLine & "Project " & i & ": " & ProjectTemp & " (Total Hours = " & Round(rsTableControl2.Fields(2), 2) & ")" |
0180 | Status_Line = Status_Line & "" & Status_Project_Name & " (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|" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "|..|" |
0189 | Else |
0190 | Temp_Line = "|II||1|" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & " (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 & " " |
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 & " " |
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 = " → 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|" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & "|..|" |
0226 | Else |
0227 | Temp_Line = "|..||1|" & Sub_Project_Temp & IIf(InStr(Sub_Project_Temp, "-") = 0, " - Reading / Writing", "") & " (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 = " → 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 = "Comments; " |
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 |
0284 | Loop |
0285 | 'Finish off last (sub-)project |
0286 | If Paper_Saved <> "" And Paper_Saved <> Last_Paper_Displayed Then |
0287 | Temp_Line = " → See " & Paper_Saved & " (" & Sub_Total & " hour" & IIf(Sub_Total <> 1, "s", "") & ")" |
0288 | Else |
0289 | Temp_Line = "" |
0290 | End If |
0291 | Temp_Line = Temp_Line & "|..|" |
0292 | If Sub_projects = "Yes" Then |
0293 | Temp_Line = Temp_Line & "|II|" |
0294 | End If |
0295 | strLine = strLine & Temp_Line |
0296 | Status_Line = Status_Line & Temp_Line |
0297 | 'Add the Status_Tasklists Row |
0298 | rsTableControl3.AddNew |
0299 | rsTableControl3.Fields(0) = Status_Project |
0300 | rsTableControl3.Fields(1) = strNote_Period |
0301 | rsTableControl3.Fields(2) = Now() |
0302 | rsTableControl3.Fields(3) = Status_Line |
0303 | rsTableControl3.Update |
0304 | 'Update Note |
0305 | rsTableControl.Fields(3) = strLine |
0306 | 'Note Title |
0307 | If YTD = "No" Then |
0308 | strLine = "Status: Summary Task List (" & StrTitle_Year & ": " & StrTitle_Month & ")" |
0309 | Else |
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 |
0315 | End If |
0316 | rsTableControl.Fields(1) = strLine |
0317 | 'Set Note Status |
0318 | rsTableControl.Fields(10) = "Temp" |
0319 | rsTableControl.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;") |
0323 | rsTableControl.AddNew |
0324 | rsTableControl.Fields(0) = Note_ID |
0325 | rsTableControl.Update |
0326 | Archive_Notes_Now = "No" |
0327 | Regenerate_the_Links = "Yes" |
0328 | Regen_Notes_Only = "Yes" |
0329 | CreateNotesWebPages |
0330 | Set rsTableControl = Nothing |
0331 | Set rsTableControl2 = Nothing |
0332 | Set rsTableControl3 = Nothing |
0333 | If automatic_processing = "Yes" Then |
0334 | Else |
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 |
0340 | End If |
0341 | End Sub |