Line-No. / Ref. | Code Line |
0001 | Private Sub cmdDevLog_Click() |
0002 | Dim x As String |
0003 | Dim rsTableControl As Recordset |
0004 | Dim strMessage As String |
0005 | Dim strQuery As String |
0006 | Dim i As Integer |
0007 | Dim strDevelopment As String |
0008 | Dim Problem As Boolean |
0009 | 'Check for data conditions that would cause problems in reporting ... |
0010 | Set rsTableControl = CurrentDb.OpenRecordset("Dud_Devlog_Descriptions") |
0011 | If Not rsTableControl.EOF Then |
0012 | MsgBox ("Development text cannot contain ""|99|"" or ""|##|""") |
0013 | DoCmd.OpenQuery ("Dud_Devlog_Descriptions") |
0014 | End |
0015 | End If |
0016 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Development FROM Development_Log WHERE Development LIKE ""*|..|*"";") |
0017 | If Not rsTableControl.EOF Then |
0018 | rsTableControl.MoveFirst |
0019 | Do While Not rsTableControl.EOF |
0020 | strDevelopment = rsTableControl.Fields(0) |
0021 | i = InStr(strDevelopment, "|..|") |
0022 | Do While i > 0 |
0023 | Problem = False |
0024 | 'Allow FNs |
0025 | If i < 6 Then |
0026 | Problem = True |
0027 | Else |
0028 | If Mid(strDevelopment, i - 4, 4) = "++FN" Then |
0029 | i = InStr(i + 1, strDevelopment, "|..|") |
0030 | Else |
0031 | Problem = True |
0032 | End If |
0033 | End If |
0034 | If Problem = True Then |
0035 | Debug.Print Now() & " - "; strDevelopment |
0036 | MsgBox ("Development text cannot contain ""|..|""") |
0037 | Stop |
0038 | End If |
0039 | If i > 0 Then |
0040 | i = InStr(i + 1, strDevelopment, "|..|") |
0041 | End If |
0042 | Loop |
0043 | rsTableControl.MoveNext |
0044 | Loop |
0045 | End If |
0046 | strMessage = "Display the Development Log? Choose from the numeric options below:-" & Chr(10) |
0047 | strMessage = strMessage & Chr(10) & "01. Full List by Category" |
0048 | strMessage = strMessage & Chr(10) & "02. All Complete by Date" |
0049 | strMessage = strMessage & Chr(10) & "03. Others Complete by Date within Category" |
0050 | strMessage = strMessage & Chr(10) & "04. Own Complete by Date within Category" |
0051 | strMessage = strMessage & Chr(10) & "05. Others Outstanding by Category" |
0052 | strMessage = strMessage & Chr(10) & "06. Others Outstanding by Category - Pri 1" |
0053 | strMessage = strMessage & Chr(10) & "07. Others Outstanding by Priority" |
0054 | strMessage = strMessage & Chr(10) & "08. Own Outstanding by Priority within Category" |
0055 | strMessage = strMessage & Chr(10) & "09. Own Outstanding by Category - Pri 1" |
0056 | strMessage = strMessage & Chr(10) & "10. Own Outstanding by Category within Priority" |
0057 | strMessage = strMessage & Chr(10) & "11. Search" |
0058 | strMessage = strMessage & Chr(10) & "12. Output Development Log Web Pages" |
0059 | x = InputBox(strMessage, "Choose a Development Log Option") |
0060 | If x = "" Then |
0061 | Exit Sub |
0062 | End If |
0063 | If Not IsNumeric(x) Then |
0064 | Exit Sub |
0065 | Else |
0066 | i = x |
0067 | End If |
0068 | strQuery = "" |
0069 | Select Case i |
0070 | Case 1 |
0071 | strQuery = "Development_Log_List" |
0072 | Case 2 |
0073 | strQuery = "Development_Log_List_Complete_Date" |
0074 | Case 3 |
0075 | strQuery = "Development_Log_List_Complete_Others_Category" |
0076 | Case 4 |
0077 | strQuery = "Development_Log_List_Complete_Own_Category" |
0078 | Case 5 |
0079 | strQuery = "Development_Log_List_Outstanding_Others_Category" |
0080 | Case 6 |
0081 | strQuery = "Development_Log_List_Outstanding_Others_Category_Pri1" |
0082 | Case 7 |
0083 | strQuery = "Development_Log_List_Outstanding_Others_Priority" |
0084 | Case 8 |
0085 | strQuery = "Development_Log_List_Outstanding_Own_Category" |
0086 | Case 9 |
0087 | strQuery = "Development_Log_List_Outstanding_Own_Category_Pri1" |
0088 | Case 10 |
0089 | strQuery = "Development_Log_List_Outstanding_Own_Priority" |
0090 | Case 11 |
0091 | strQuery = "Development_Log_Search" |
0092 | Case 12 |
0093 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE ((((Notes.ID)=822)) OR (((Notes.ID)=981)));") |
0094 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Outstanding Developments (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=981)));") |
0095 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Progress to Date (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=822)));") |
0096 | DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;") |
0097 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=822));") 'Regenerate the "Website - Progress to Date" Note |
0098 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note |
0099 | Archive_Notes_Now = "No" |
0100 | Regenerate_the_Links = "No" |
0101 | Regen_Notes_Only = "Yes" |
0102 | CreateNotesWebPages ("Yes") |
0103 | MsgBox ("Development Log Web Pages Output OK") |
0104 | Exit Sub |
0105 | Case Else |
0106 | Exit Sub |
0107 | End Select |
0108 | DoCmd.OpenQuery (strQuery) |
0109 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Private Sub cmdDocumenter_Click() |
0002 | Dim strMessage As String |
0003 | Dim StartTime As Double |
0004 | Dim rsTableToRead As Recordset |
0005 | Dim Duration As Double |
0006 | Dim strRunTime As String |
0007 | Dim RunDate As Date |
0008 | Dim MsgboxMsg As String |
0009 | Dim Get_Going As Boolean |
0010 | NoReusedQueryNames = 0 |
0011 | NoAmbiguousNames = 0 |
0012 | NoImages = 0 |
0013 | NoUnusedQueries = 0 |
0014 | NoUnusedVariables = 0 |
0015 | NoDeletedQueries = 0 |
0016 | NoNameClashes = 0 |
0017 | NoDevelopmentLogItems = 0 |
0018 | SubSystem = "" |
0019 | Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""Documentation_Generator"";") |
0020 | RunDate = rsTableToRead.Fields(1) |
0021 | strRunTime = Round(rsTableToRead.Fields(2), 1) |
0022 | strMessage = "Do you want to run the Application Documenter?" & Chr$(10) & "The ""Document_Tables_Full"" parameter is set to " & IIf(Document_Tables_Full = True, "True", "False") & Chr$(10) & "The ""Document_Queries_Full"" parameter is set to " & IIf(Document_Queries_Full = True, "True", "False") |
0023 | strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes." |
0024 | RootCreated = "" |
0025 | Get_Going = False |
0026 | If MsgBox(strMessage, vbYesNo) = vbYes Then |
0027 | Else |
0028 | If Document_Tables_Full = False Or Document_Queries_Full = False Then |
0029 | strMessage = "Would you like to document tables and queries in full?" |
0030 | If MsgBox(strMessage, vbYesNo) = vbYes Then |
0031 | Document_Tables_Full = True |
0032 | Document_Queries_Full = True |
0033 | Else |
0034 | Exit Sub |
0035 | End If |
0036 | Else |
0037 | Exit Sub |
0038 | End If |
0039 | End If |
0040 | StartTime = Now() |
0041 | Documentation_Generator |
0042 | Duration = Round((Now() - StartTime) * 24 * 60, 1) |
0043 | rsTableToRead.Edit |
0044 | rsTableToRead.Fields(1) = Now() |
0045 | rsTableToRead.Fields(2) = Duration |
0046 | rsTableToRead.Update |
0047 | MsgboxMsg = "" |
0048 | MsgboxMsg = MsgboxMsg & "There are " & NoDevelopmentLogItems & " items in the Development Log." & Chr$(10) |
0049 | If NoDeletedQueries = 0 Then |
0050 | Else |
0051 | If NoDeletedQueries = 1 Then |
0052 | MsgboxMsg = MsgboxMsg & "There is " & NoDeletedQueries & " allegedly deleted Query in the database." & Chr$(10) |
0053 | Else |
0054 | MsgboxMsg = MsgboxMsg & "There are " & NoDeletedQueries & " allegedly deleted Queries in the database." & Chr$(10) |
0055 | End If |
0056 | End If |
0057 | If NoUnusedVariables <> 0 Then |
0058 | MsgboxMsg = MsgboxMsg & "There are " & NoUnusedVariables & " allegedly unused Variables in the database." & Chr$(10) |
0059 | End If |
0060 | MsgboxMsg = MsgboxMsg & "There are " & NoImages & " Images allegedly on my website. " & Chr$(10) |
0061 | MsgboxMsg = MsgboxMsg & "There are " & NoUnusedQueries & " allegedly unused Queries in the database." & Chr$(10) |
0062 | If NoAmbiguousNames = 0 Then |
0063 | Else |
0064 | If NoAmbiguousNames = 1 Then |
0065 | MsgboxMsg = MsgboxMsg & "There is " & NoAmbiguousNames & " ambiguous name in the Code." |
0066 | Else |
0067 | MsgboxMsg = MsgboxMsg & "There are " & NoAmbiguousNames & " ambiguous names in the Code." |
0068 | End If |
0069 | MsgboxMsg = MsgboxMsg & Chr$(10) |
0070 | End If |
0071 | If NoNameClashes = 0 Then |
0072 | Else |
0073 | If NoNameClashes = 1 Then |
0074 | MsgboxMsg = MsgboxMsg & "There is " & NoNameClashes & " procedure / variable name clash in the Code." |
0075 | Else |
0076 | MsgboxMsg = MsgboxMsg & "There are " & NoNameClashes & " procedure / variable name clashes in the Code." |
0077 | End If |
0078 | MsgboxMsg = MsgboxMsg & Chr$(10) |
0079 | End If |
0080 | If NoReusedQueryNames = 0 Then |
0081 | Else |
0082 | If NoReusedQueryNames = 1 Then |
0083 | MsgboxMsg = MsgboxMsg & "There is " & NoReusedQueryNames & " re-used Query Name. " |
0084 | Else |
0085 | MsgboxMsg = MsgboxMsg & "There are " & NoReusedQueryNames & " re-used Query Names." |
0086 | End If |
0087 | MsgboxMsg = MsgboxMsg & Chr$(10) |
0088 | End If |
0089 | MsgboxMsg = MsgboxMsg & Chr$(10) & Chr$(10) |
0090 | MsgBox (MsgboxMsg & "The lists follow ... Investigate them and consider pruning. " & Chr$(10) & Chr$(10) & "Documentation Complete in " & Duration & " minutes.") |
0091 | Set rsTableToRead = Nothing |
0092 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Private Sub cmdMonthSummary_Click() |
0002 | 'These are actually the Quarterly & YTD detailed reports (and the Priority Task List)! |
0003 | Dim Quarterly As Boolean |
0004 | Dim Annual As Boolean |
0005 | Dim Priority As Boolean |
0006 | Dim Start_Time As Date |
0007 | Dim strMsg As String |
0008 | Dim rsTableControl As Recordset |
0009 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE (((Notes.ID)=1266)) OR (((Notes.ID)=1275)) OR (((Notes.ID)=975));") |
0010 | If MsgBox("Have you set the Reporting Month?", vbYesNo) = vbYes Then |
0011 | If MsgBox("Output the Annual Report?", vbYesNo) = vbYes Then |
0012 | Annual = True |
0013 | Else |
0014 | Annual = False |
0015 | End If |
0016 | If MsgBox("Output the Quarterly Report?", vbYesNo) = vbYes Then |
0017 | Quarterly = True |
0018 | Else |
0019 | Quarterly = False |
0020 | End If |
0021 | If MsgBox("Output the Priority Task List Report?", vbYesNo) = vbYes Then |
0022 | Priority = True |
0023 | Else |
0024 | Priority = False |
0025 | End If |
0026 | automatic_processing = "Yes" |
0027 | Start_Time = Now() |
0028 | 'Annual Report |
0029 | If Annual = True Then |
0030 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Zap") |
0031 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Gen") |
0032 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Nulls_Reset") |
0033 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Read_UPD") |
0034 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Write_UPD") |
0035 | DoCmd.OpenQuery ("Time_This_Month_List_Zap") |
0036 | DoCmd.OpenQuery ("Time_This_Month_List_YTD_Gen") |
0037 | DoCmd.OpenQuery ("Time_This_Month_List_Paper_UPD") |
0038 | DoCmd.OpenQuery ("Time_This_Month_List_Book_UPD") |
0039 | Monthly_Report_Note975_Update ("Yes") |
0040 | End If |
0041 | 'Quarterly Report |
0042 | If Quarterly = True Then |
0043 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Zap") |
0044 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Gen") |
0045 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Nulls_Reset") |
0046 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Read_UPD") |
0047 | DoCmd.OpenQuery ("Time_This_Month_List_Temp_Write_UPD") |
0048 | DoCmd.OpenQuery ("Time_This_Month_List_Zap") |
0049 | DoCmd.OpenQuery ("Time_This_Month_List_Gen") |
0050 | DoCmd.OpenQuery ("Time_This_Month_List_Paper_UPD") |
0051 | DoCmd.OpenQuery ("Time_This_Month_List_Book_UPD") |
0052 | Monthly_Report_Note975_Update ("No") |
0053 | End If |
0054 | If Priority = True Then |
0055 | 'Output the note |
0056 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Status: Priority Task List (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=1275)));") |
0057 | DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;") |
0058 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;") |
0059 | rsTableControl.AddNew |
0060 | rsTableControl.Fields(0) = 1275 |
0061 | rsTableControl.Update |
0062 | Archive_Notes_Now = "No" |
0063 | Regenerate_the_Links = "Yes" |
0064 | Regen_Notes_Only = "Yes" |
0065 | CreateNotesWebPages |
0066 | Set rsTableControl = Nothing |
0067 | End If |
0068 | Else |
0069 | DoCmd.OpenTable ("Next_Reporting_Month") |
0070 | If MsgBox("Have you just changed the copyright month and want to run the update?", vbYesNo) = vbYes Then |
0071 | DoCmd.OpenQuery ("WebPage_DateChange") |
0072 | End If |
0073 | End If |
0074 | If Quarterly = True Or Annual = True Or Priority = True Then |
0075 | strMsg = "" |
0076 | If Annual = True Then |
0077 | strMsg = "YTD Summary Task List (Note 1266); " |
0078 | End If |
0079 | If Quarterly = True Then |
0080 | strMsg = strMsg & "This Quarter's Summary Task List (Note 975); " |
0081 | End If |
0082 | If Priority = True Then |
0083 | strMsg = strMsg & "Priority Task List (Note 1275) " |
0084 | End If |
0085 | If Right(strMsg, 2) = "; " Then |
0086 | strMsg = Left(strMsg, Len(strMsg) - 2) & " " |
0087 | End If |
0088 | MsgBox (strMsg & "output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.") |
0089 | End If |
0090 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Private Sub cmdNotes_Click() |
0002 | Dim rsTableControl As Recordset |
0003 | Dim rsTableToRead As Recordset |
0004 | Dim rs As Recordset |
0005 | Dim First_Note_To_Regen As String |
0006 | Dim Regen_Blurb As String |
0007 | Dim i As Integer |
0008 | Dim j As Integer |
0009 | Dim Temp_Note_ID |
0010 | Dim Start_Note_ID As Integer |
0011 | Dim End_Note_ID As Integer |
0012 | Dim strControlQuery As String |
0013 | Dim strMessage As String |
0014 | Dim StartTime As Date |
0015 | Dim RunStartTime As Date |
0016 | Dim Duration As Double |
0017 | Dim Response As String |
0018 | Dim Total_Run As Single |
0019 | Dim Run_Type As String |
0020 | Dim RunDate As Date |
0021 | Dim NumberOfRows As Integer |
0022 | Dim RowCount As Integer |
0023 | Dim StopRows As Boolean |
0024 | Dim Etc_Message As String |
0025 | Dim Option_Help As String |
0026 | Dim Notes_Option As String |
0027 | If MsgBox("Update / Regenerate Thesis / PID Notes?", vbYesNo + vbDefaultButton2) = vbYes Then |
0028 | 'Check for inconsistent Dates in PID_Note_Reading_Lists table |
0029 | Set rs = CurrentDb.OpenRecordset("PID_Note_Reading_Lists_Date_XChk") |
0030 | If Not rs.EOF Then |
0031 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_Date_XChk") |
0032 | If MsgBox("Inconsistencies in PID_Note_Reading_Lists Dates. Abort to fix?", vbYesNo) = vbYes Then |
0033 | Exit Sub |
0034 | End If |
0035 | End If |
0036 | Option_Help = "1. Open the PID_Note_Reading_Lists table?" |
0037 | Option_Help = Option_Help & Chr$(10) & "2. Update PID_Note_Reading_Lists table for a particular Note?" |
0038 | Option_Help = Option_Help & Chr$(10) & "3. Update PID_Note_Reading_Lists table for a particular Paper?" |
0039 | Option_Help = Option_Help & Chr$(10) & "4. Update PID_Note_Reading_Lists table for a particular Book?" |
0040 | Option_Help = Option_Help & Chr$(10) & "5. Open the Thesis_Note_XRef table?" |
0041 | Option_Help = Option_Help & Chr$(10) & "6. Open Thesis PID Note Usage Queries?" |
0042 | Option_Help = Option_Help & Chr$(10) & "7. Open Thesis Missing Book/Papers Queries?" |
0043 | Option_Help = Option_Help & Chr$(10) & "8. Regenerate Functors in Live Note(s)?" |
0044 | Notes_Option = InputBox(Option_Help, "Enter an integer Notes Option", 1) |
0045 | If Len(Notes_Option) = 0 Then |
0046 | End |
0047 | End If |
0048 | If Notes_Option < "1" Or Notes_Option > "8" Then |
0049 | MsgBox ("Choose an Option between 1 and 8") |
0050 | End |
0051 | End If |
0052 | Select Case Notes_Option |
0053 | Case 1 |
0054 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_List") |
0055 | Case 2 |
0056 | DoCmd.OpenQuery ("qry_PID_Note_Reading_Lists_Note") |
0057 | Case 3 |
0058 | DoCmd.OpenQuery ("qry_PID_Note_Reading_Lists_Paper") |
0059 | Case 4 |
0060 | DoCmd.OpenQuery ("qry_PID_Note_Reading_Lists_Book") |
0061 | Case 5 |
0062 | DoCmd.OpenQuery ("Thesis_Note_XRef_List") |
0063 | Case 6 |
0064 | DoCmd.OpenQuery ("PID_Notes_By_Thesis_Chapter") |
0065 | DoCmd.OpenQuery ("PID_Notes_Unused_By_Thesis") |
0066 | DoCmd.OpenQuery ("PID_Notes_Used_By_Thesis_Chapter") |
0067 | Case 7 |
0068 | DoCmd.OpenQuery ("Books_Missing_By_Thesis_Chapter") |
0069 | DoCmd.OpenQuery ("Papers_Missing_By_Thesis_Chapter") |
0070 | DoCmd.OpenQuery ("IdentityPapersRead_Unreferenced") |
0071 | Case 8 |
0072 | OK = Update_Live_Notes_Functor() |
0073 | End Select |
0074 | Exit Sub |
0075 | End If |
0076 | RootCreated = "" |
0077 | If MsgBox("Do you want to regenerate Notes Web-pages?", vbYesNo) <> vbYes Then |
0078 | Exit Sub |
0079 | End If |
0080 | Run_Type = "" |
0081 | Temp_Notes_Only = "No" |
0082 | Changed_Notes_Only = "No" |
0083 | Include_Associated_Notes = "No" |
0084 | Regen_Notes_Only = "No" |
0085 | Regenerate_the_Links = "No" |
0086 | Archive_Notes_Now = "No" |
0087 | 'Check how many notes regenerated last time - and show the first |
0088 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.Note_ID, IIf([Item_Title] & """"="""",""Invalid Note ID"",[Item_Title]) AS [Note Title] FROM Notes_To_Regen LEFT JOIN Notes ON Notes_To_Regen.Note_ID = Notes.ID ORDER BY IIf([Item_Title] & """"="""",""Invalid Note ID"",[Item_Title]);") |
0089 | First_Note_To_Regen = 0 |
0090 | i = 0 |
0091 | If Not rsTableControl.EOF Then |
0092 | rsTableControl.MoveFirst |
0093 | First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) |
0094 | i = rsTableControl.RecordCount |
0095 | End If |
0096 | If i = 0 Then |
0097 | Regen_Blurb = "" |
0098 | Else |
0099 | If i = 1 Then |
0100 | Regen_Blurb = "Do you want to select the same Note as last time? The Note is " & First_Note_To_Regen & ")." |
0101 | Else |
0102 | If i > 9 Then |
0103 | Regen_Blurb = "The first 10 Notes (of " & i & ") are:-" & Chr$(10) |
0104 | Else |
0105 | Regen_Blurb = "The " & i & " Notes are:-" & Chr$(10) |
0106 | End If |
0107 | For j = 1 To 10 |
0108 | If rsTableControl.EOF Then |
0109 | j = 11 |
0110 | Else |
0111 | First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) |
0112 | Regen_Blurb = Regen_Blurb & IIf(j = 1, "", ",") & Chr$(10) & "..." & rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) & ")" |
0113 | rsTableControl.MoveNext |
0114 | End If |
0115 | Next j |
0116 | Regen_Blurb = "Do you want to select the same Notes as last time? " & Regen_Blurb |
0117 | End If |
0118 | End If |
0119 | If MsgBox("Do you want to select individual Notes?", vbYesNo + vbDefaultButton1) = vbYes Then |
0120 | If Regen_Blurb = "" Then |
0121 | Else |
0122 | If MsgBox(Regen_Blurb, vbYesNo) <> vbYes Then |
0123 | Regen_Blurb = "" |
0124 | End If |
0125 | End If |
0126 | If Regen_Blurb = "" Then |
0127 | DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;") |
0128 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;") |
0129 | Temp_Note_ID = 1 |
0130 | Do While Temp_Note_ID <> 0 |
0131 | Temp_Note_ID = 0 |
0132 | Temp_Note_ID = InputBox("Enter a Note ID") |
0133 | Temp_Note_ID = Val(Temp_Note_ID) |
0134 | If Temp_Note_ID <> 0 Then |
0135 | rsTableControl.AddNew |
0136 | rsTableControl.Fields(0) = Temp_Note_ID |
0137 | On Error Resume Next |
0138 | rsTableControl.Update |
0139 | If Err.Number = 3022 Then |
0140 | MsgBox ("Duplicate Note (" & Temp_Note_ID & ") selected") |
0141 | End If |
0142 | Err.Number = 0 |
0143 | End If |
0144 | Loop |
0145 | 'Check whether we got it right! |
0146 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.Note_ID, IIf([Item_Title] & """"="""",""Invalid Note ID"",[Item_Title]) AS [Note Title] FROM Notes_To_Regen LEFT JOIN Notes ON Notes_To_Regen.Note_ID = Notes.ID ORDER BY IIf([Item_Title] & """"="""",""Invalid Note ID"",[Item_Title]);") |
0147 | First_Note_To_Regen = 0 |
0148 | i = 0 |
0149 | If Not rsTableControl.EOF Then |
0150 | rsTableControl.MoveFirst |
0151 | First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) |
0152 | i = rsTableControl.RecordCount |
0153 | End If |
0154 | If i = 0 Then |
0155 | Regen_Blurb = "" |
0156 | Else |
0157 | If i = 1 Then |
0158 | Regen_Blurb = "Do you want to select this Note? The Note is " & First_Note_To_Regen & ")." |
0159 | Else |
0160 | If i > 9 Then |
0161 | Regen_Blurb = "The first 10 Notes (of " & i & ") are:-" & Chr$(10) |
0162 | Else |
0163 | Regen_Blurb = "The " & i & " Notes are:-" & Chr$(10) |
0164 | End If |
0165 | For j = 1 To 10 |
0166 | If rsTableControl.EOF Then |
0167 | j = 11 |
0168 | Else |
0169 | First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) |
0170 | Regen_Blurb = Regen_Blurb & IIf(j = 1, "", ",") & Chr$(10) & "..." & rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) & ")" |
0171 | rsTableControl.MoveNext |
0172 | End If |
0173 | Next j |
0174 | Regen_Blurb = "Do you want to select these Notes? " & Regen_Blurb |
0175 | End If |
0176 | End If |
0177 | If i > 0 Then |
0178 | If MsgBox(Regen_Blurb, vbYesNo) <> vbYes Then |
0179 | MsgBox ("Try again then!") |
0180 | Exit Sub |
0181 | End If |
0182 | End If |
0183 | End If |
0184 | Else |
0185 | DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;") |
0186 | If MsgBox("Do you want to regenerate ranges of Notes based on the Note_Regen_Ranges table?", vbYesNo + vbDefaultButton2) = vbYes Then |
0187 | Regen_Notes_Only = "Yes" |
0188 | Run_Type = "Ranges" |
0189 | Etc_Message = " ... Etc. " & Chr(10) |
0190 | Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;") |
0191 | If Not rsTableToRead.EOF Then |
0192 | rsTableToRead.MoveFirst |
0193 | NumberOfRows = rsTableToRead.RecordCount |
0194 | RowCount = 0 |
0195 | StopRows = False |
0196 | strMessage = "Run for the following range" & IIf(rsTableToRead.RecordCount > 1, "s", "") & "?" & Chr(10) & Chr(10) |
0197 | Do While Not rsTableToRead.EOF |
0198 | RowCount = RowCount + 1 |
0199 | If RowCount < 15 Then |
0200 | strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10) |
0201 | Else |
0202 | If StopRows = False Then |
0203 | If NumberOfRows > 20 Then |
0204 | StopRows = True |
0205 | strMessage = strMessage & Etc_Message |
0206 | Else |
0207 | strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10) |
0208 | End If |
0209 | End If |
0210 | End If |
0211 | Total_Run = Total_Run + rsTableToRead.Fields(5) |
0212 | rsTableToRead.MoveNext |
0213 | Loop |
0214 | strMessage = strMessage & "Total time = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10) |
0215 | Else |
0216 | DoCmd.OpenTable ("Note_Regen_Ranges") |
0217 | MsgBox ("No Ranges selected. Update the Note_Regen_Ranges Table.") |
0218 | End |
0219 | End If |
0220 | Total_Run = 0 |
0221 | Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = False ORDER BY ID_Start;") |
0222 | If Not rsTableToRead.EOF Then |
0223 | NumberOfRows = NumberOfRows + rsTableToRead.RecordCount |
0224 | strMessage = strMessage & "Not selected:- " & Chr(10) & Chr(10) |
0225 | rsTableToRead.MoveFirst |
0226 | Do While Not rsTableToRead.EOF |
0227 | RowCount = RowCount + 1 |
0228 | If StopRows = False Then |
0229 | strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10) |
0230 | End If |
0231 | If RowCount > 18 Then |
0232 | If NumberOfRows > 20 Then |
0233 | StopRows = True |
0234 | strMessage = strMessage & Etc_Message |
0235 | Etc_Message = "" |
0236 | End If |
0237 | End If |
0238 | Total_Run = Total_Run + rsTableToRead.Fields(5) |
0239 | rsTableToRead.MoveNext |
0240 | Loop |
0241 | strMessage = strMessage & "Total time outstanding = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10) |
0242 | End If |
0243 | Response = MsgBox(strMessage, vbYesNo) |
0244 | If Response = vbNo Then |
0245 | DoCmd.OpenTable ("Note_Regen_Ranges") |
0246 | MsgBox ("Update the Note_Regen_Ranges Table.") |
0247 | End |
0248 | Else |
0249 | RunStartTime = Now() |
0250 | Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;") |
0251 | If Not rsTableToRead.EOF Then |
0252 | rsTableToRead.MoveFirst |
0253 | StartTime = Now() |
0254 | Do While Not rsTableToRead.EOF |
0255 | 'Clear Notes_To_Regen table & ready for inserts |
0256 | DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;") |
0257 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;") |
0258 | 'Update the table |
0259 | Start_Note_ID = rsTableToRead.Fields(1) |
0260 | End_Note_ID = rsTableToRead.Fields(2) |
0261 | For Temp_Note_ID = Start_Note_ID To End_Note_ID |
0262 | rsTableControl.AddNew |
0263 | rsTableControl.Fields(0) = Temp_Note_ID |
0264 | rsTableControl.Update |
0265 | Next Temp_Note_ID |
0266 | automatic_processing = "Yes" |
0267 | CreateNotesWebPages |
0268 | 'Update the control table |
0269 | Duration = Now() - StartTime |
0270 | Duration = Duration * 24 * 60 |
0271 | Duration = Round(Duration, 1) |
0272 | RunDate = Now() |
0273 | rsTableToRead.Edit |
0274 | rsTableToRead.Fields(4) = RunDate |
0275 | rsTableToRead.Fields(5) = Duration |
0276 | rsTableToRead.Update |
0277 | StartTime = Now() |
0278 | rsTableToRead.MoveNext |
0279 | Loop |
0280 | End If |
0281 | End If |
0282 | Else |
0283 | If MsgBox("Do you want to regenerate a bespoke range of Notes?", vbYesNo + vbDefaultButton2) = vbYes Then |
0284 | Regen_Notes_Only = "Yes" |
0285 | Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;") |
0286 | Temp_Note_ID = InputBox("Enter Start Note ID") |
0287 | Temp_Note_ID = Val(Temp_Note_ID) |
0288 | If Temp_Note_ID > 0 Then |
0289 | Start_Note_ID = Temp_Note_ID |
0290 | Temp_Note_ID = InputBox("Enter End Note ID") |
0291 | Temp_Note_ID = Val(Temp_Note_ID) |
0292 | If Temp_Note_ID > 0 Then |
0293 | If Temp_Note_ID > Start_Note_ID Then |
0294 | End_Note_ID = Temp_Note_ID |
0295 | For Temp_Note_ID = Start_Note_ID To End_Note_ID |
0296 | rsTableControl.AddNew |
0297 | rsTableControl.Fields(0) = Temp_Note_ID |
0298 | rsTableControl.Update |
0299 | Next Temp_Note_ID |
0300 | End If |
0301 | End If |
0302 | End If |
0303 | End If |
0304 | End If |
0305 | End If |
0306 | If Run_Type = "Ranges" Then |
0307 | GoTo The_End |
0308 | End If |
0309 | 'Check for individually-selected or range-selected Notes |
0310 | strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto INNER JOIN Notes_To_Regen ON Notes_List_Auto.ID = Notes_To_Regen.Note_ID ORDER BY Notes_List_Auto.ID;" |
0311 | Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery) |
0312 | If Not rsTableToRead.EOF Then |
0313 | Regen_Notes_Only = "Yes" |
0314 | If MsgBox("Regenerate the Links?", vbYesNo + vbDefaultButton2) = vbYes Then |
0315 | Regenerate_the_Links = "Yes" |
0316 | End If |
0317 | Else |
0318 | Regenerate_the_Links = "Yes" |
0319 | Archive_Notes_Now = "Yes" |
0320 | 'Check if only doing Temp Notes - Read Temp Notes records |
0321 | strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Status = ""Temp"" ORDER BY Notes_List_Auto.ID;" |
0322 | Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery) |
0323 | If Not rsTableToRead.EOF Then |
0324 | If MsgBox("Temp Notes only?", vbYesNo + vbDefaultButton2) = vbYes Then |
0325 | Archive_Notes_Now = "No" |
0326 | Temp_Notes_Only = "Yes" |
0327 | GoTo Create_Notes |
0328 | End If |
0329 | End If |
0330 | If MsgBox("Changed Notes only?", vbYesNo) = vbYes Then |
0331 | Changed_Notes_Only = "Yes" |
0332 | If MsgBox("Include Notes Linked to Changed Notes?", vbYesNo + vbDefaultButton2) = vbYes Then |
0333 | Include_Associated_Notes = "Yes" |
0334 | End If |
0335 | End If |
0336 | End If |
0337 | Create_Notes: |
0338 | 'Final Check .. |
0339 | Regen_Blurb = "The selected parameters are as follows:- " & Chr$(10) & Chr$(10) & "Temp_Notes_Only = " & Temp_Notes_Only & Chr$(10) & "Changed_Notes_Only = " & Changed_Notes_Only & Chr$(10) & "Include_Associated_Notes = " & Include_Associated_Notes & Chr$(10) & "Regen_Notes_Only = " & Regen_Notes_Only & Chr$(10) & "Regenerate_the_Links = " & Regenerate_the_Links & Chr$(10) & "Archive_Notes_Now = " & Archive_Notes_Now & Chr$(10) & Chr$(10) & "If you want to continue, reply ""OK"" else ""Cancel"". " |
0340 | If MsgBox(Regen_Blurb, vbOKCancel) = vbCancel Then |
0341 | Exit Sub |
0342 | Else |
0343 | automatic_processing = "No" |
0344 | CreateNotesWebPages |
0345 | End If |
0346 | The_End: |
0347 | If Run_Type = "Ranges" Then |
0348 | Duration = Round((Now() - RunStartTime) * 24 * 60, 1) |
0349 | If Duration < 1 Then |
0350 | Duration = Round((Now() - RunStartTime) * 24 * 60 * 60) |
0351 | MsgBox "Note Ranges Regeneration Complete in " & Duration & " seconds.", vbOKOnly, "Create Notes Webpages" |
0352 | Else |
0353 | MsgBox "Note Ranges Regeneration Complete in " & Duration & " minutes.", vbOKOnly, "Create Notes Webpages" |
0354 | End If |
0355 | End If |
0356 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Private Sub cmdRecalculate_Click() |
0002 | Dim start As Date |
0003 | Dim Duration As Single |
0004 | Dim rsTableToRead As Recordset |
0005 | Dim strDoubleQuote As String |
0006 | Dim strQuery As String |
0007 | Dim i As Integer |
0008 | Dim Question |
0009 | Dim rs As Recordset |
0010 | Dim rsRefs As Recordset |
0011 | Dim rsTopics As Recordset |
0012 | Dim rsSubTopics As Recordset |
0013 | Dim rsCheck As Recordset |
0014 | Dim strMsg As String |
0015 | OK = Check_Database_Size() |
0016 | Debug.Print Now() & " - Main Database size = " & Check_Database_Size & "Mb" |
0017 | start = Now() |
0018 | 'Add PID-Related Aeon Papers |
0019 | Set rs = CurrentDb.OpenRecordset("Aeon_Papers_Add_Prelist") |
0020 | If Not rs.EOF Then |
0021 | Set rs = Nothing |
0022 | Set rs = CurrentDb.OpenRecordset("Aeon_Papers_Update_Query_Year_Chk") |
0023 | rs.MoveFirst |
0024 | If rs.Fields(0) = "No" Then |
0025 | DoCmd.OpenQuery ("Aeon_Papers_Add_Prelist") |
0026 | DoCmd.OpenQuery ("Aeon_Papers_Add") |
0027 | DoCmd.OpenQuery ("Aeon_Papers_LastYearHours_Add") |
0028 | DoCmd.OpenQuery ("Aeon_Papers_LastYearHours_Total") |
0029 | DoCmd.OpenQuery ("Aeon_Papers_PaperID_Updt") |
0030 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_Year_Updt") |
0031 | DoCmd.OpenQuery ("Aeon_Date_Fixes") |
0032 | DoCmd.OpenQuery ("Aeon_Timesheet_Updates") |
0033 | Else |
0034 | strMsg = "Update Aeon Queries Aeon_Papers_LastYearHours_Add, Aeon_Papers_LastYearHours_Total and then Aeon_Papers_Update_Query_Year_Chk with new previous year" |
0035 | Debug.Print Now() & " - " & strMsg |
0036 | MsgBox (strMsg) |
0037 | End If |
0038 | Set rs = Nothing |
0039 | End If |
0040 | DoCmd.RunSQL ("DELETE * FROM Paper_Citings_List_New;") |
0041 | DoCmd.OpenQuery ("Paper_Citings_List_New_Gen") |
0042 | DoCmd.RunSQL ("DELETE * FROM Book_Citings_List_New;") |
0043 | DoCmd.OpenQuery ("Book_Citings_List_New_Gen") |
0044 | DoCmd.RunSQL ("DELETE * FROM Authors_Cited_By_All_List;") |
0045 | DoCmd.OpenQuery ("Authors_Cited_By_All_List_Gen") |
0046 | DoCmd.RunSQL ("DELETE * FROM Notes_Cited_By_All_List;") |
0047 | DoCmd.OpenQuery ("Notes_Cited_By_All_List_Gen") |
0048 | DoCmd.RunSQL ("DELETE * FROM BookPaperAbstracts_List;") |
0049 | DoCmd.OpenQuery ("BookPaperAbstracts_List_Gen") |
0050 | 'New Year Stuff |
0051 | If (Month(Now()) = 9 And Day(Now()) > 28) Then |
0052 | MsgBox ("Warning - the new academic year is about to start - you need to set things up for the new year!") |
0053 | Else |
0054 | If (Month(Now()) = 10 And Day(Now()) = 1) Then 'Need to set this check up to see if I've actually done this ... |
0055 | MsgBox ("Warning - the new academic year has started - you need to set things up for the new year!") |
0056 | If MsgBox("Would you like to run the New_Year_Crosstab_Prime update? The queries & various tables have to be updated first!", vbYesNo) = vbYes Then |
0057 | Change_Of_Year 'This will Stop ... perform the changes to queries, etc, first. Alternatively, just run Sub Change_Of_Year on its own. |
0058 | End If |
0059 | End If |
0060 | End If |
0061 | 'Ask now for use later ... |
0062 | Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;") |
0063 | Question = vbYes |
0064 | i = rsTableToRead.RecordCount |
0065 | If i > 5 Then |
0066 | Question = MsgBox("Regenerate " & i & " Notes?", vbYesNo) |
0067 | End If |
0068 | 'Produce Oboe-Practice report |
0069 | DoCmd.OpenQuery ("Oboe_Latest_Lesson_Zap") |
0070 | DoCmd.OpenQuery ("Oboe_Latest_Lesson_GEN") |
0071 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap") |
0072 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap") |
0073 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN") |
0074 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN") |
0075 | DoCmd.OpenQuery ("Oboe_Practice_Hours_ADD") |
0076 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Zeroise") |
0077 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Update") |
0078 | 'Since last lesson |
0079 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap") |
0080 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap") |
0081 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN") |
0082 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_2021_GEN") |
0083 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_LastYear_GEN") |
0084 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Last_Lesson_Prune") |
0085 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN") |
0086 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Latest_Lesson_Update") |
0087 | DoCmd.OpenQuery ("Oboe_Practice_Hours_List") |
0088 | 'Check for Object titles with Double-quotes |
0089 | strDoubleQuote = """""" |
0090 | strDoubleQuote = "*" & strDoubleQuote & "*" |
0091 | strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));" |
0092 | Set rsCheck = CurrentDb.OpenRecordset(strQuery) |
0093 | If Not rsCheck.EOF Then |
0094 | Stop |
0095 | End If |
0096 | strQuery = "SELECT Notes_Archive.Item_Title FROM Notes_Archive WHERE (((Notes_Archive.Item_Title) Like """ & strDoubleQuote & """));" |
0097 | Set rsCheck = CurrentDb.OpenRecordset(strQuery) |
0098 | If Not rsCheck.EOF Then |
0099 | Stop |
0100 | End If |
0101 | strQuery = "SELECT Papers.Title FROM Papers WHERE (((Papers.Title) Like """ & strDoubleQuote & """));" |
0102 | Set rsCheck = CurrentDb.OpenRecordset(strQuery) |
0103 | If Not rsCheck.EOF Then |
0104 | Stop |
0105 | End If |
0106 | strQuery = "SELECT Books.Title FROM Books WHERE (((Books.Title) Like """ & strDoubleQuote & """));" |
0107 | Set rsCheck = CurrentDb.OpenRecordset(strQuery) |
0108 | If Not rsCheck.EOF Then |
0109 | Stop |
0110 | End If |
0111 | 'Check for Books with Comments containing "++nnn++" style Note-links |
0112 | strQuery = "SELECT Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++*""));" |
0113 | Set rsCheck = CurrentDb.OpenRecordset(strQuery) |
0114 | If Not rsCheck.EOF Then |
0115 | Stop |
0116 | End If |
0117 | WebpageGenDud_Abstracts_Papers |
0118 | WebpageGenDud_Abstracts_Books |
0119 | 'Regenerate "Time_By_Weekday_Prelist" Table |
0120 | DoCmd.RunSQL ("DELETE Time_By_Weekday_Prelist.* FROM Time_By_Weekday_Prelist;") |
0121 | DoCmd.OpenQuery ("Time_By_Weekday_Prelist_GEN") |
0122 | 'Add any idempotent Alternates for new Notes |
0123 | DoCmd.OpenQuery ("Note_Alternates_Add") |
0124 | 'Encode Weblinks |
0125 | OK = Convert_Webrefs("Author") |
0126 | OK = Convert_Webrefs("Book") |
0127 | OK = Convert_Webrefs("Note") |
0128 | OK = Convert_Webrefs("Note_Archive") |
0129 | OK = Convert_Webrefs("Paper") |
0130 | Update_Note_Groups_Latest_Timestamp |
0131 | 'Fix the IDs before continuing ... need to add code using above query as a list, and using Sub-Topics_ID_Max (re-run) for the next ID |
0132 | Set rsSubTopics = CurrentDb.OpenRecordset("SELECT * FROM [Sub-Topics] WHERE [Sub-Topics]!ID = 0;") |
0133 | Set rsTopics = CurrentDb.OpenRecordset("SELECT Topics.ID, Topics.Topic, Topics.Rationale, Topics.File_Type FROM Topics LEFT JOIN [Sub-Topics] ON Topics.Topic = [Sub-Topics].[Sub-Topic] WHERE ((([Sub-Topics].ID) Is Null));") |
0134 | If Not rsTopics.EOF Then |
0135 | rsTopics.MoveFirst |
0136 | Do Until rsTopics.EOF |
0137 | Set rsRefs = CurrentDb.OpenRecordset("Sub-Topics_ID_Max") |
0138 | rsSubTopics.AddNew |
0139 | rsSubTopics.Fields(0) = rsRefs.Fields(0) |
0140 | rsSubTopics.Fields(1) = rsTopics.Fields(1) |
0141 | rsSubTopics.Fields(2) = rsTopics.Fields(0) |
0142 | rsSubTopics.Fields(3) = rsTopics.Fields(2) |
0143 | rsSubTopics.Fields(4) = rsTopics.Fields(3) |
0144 | rsSubTopics.Update |
0145 | Set rsRefs = Nothing |
0146 | rsTopics.MoveNext |
0147 | Loop |
0148 | End If |
0149 | Set rsTopics = Nothing |
0150 | Set rsSubTopics = Nothing |
0151 | DoCmd.OpenQuery ("Books_Versus_Papers_Add") |
0152 | DoCmd.OpenQuery ("Paper_Book_IDs_Update") |
0153 | DoCmd.OpenQuery ("Paper_Book_IDs_Move_Update") |
0154 | DoCmd.OpenQuery ("PID_Missing_Online_Papers_Add") |
0155 | 'Delete current-year actuals prior to replacing |
0156 | DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;") |
0157 | DoCmd.RunSQL ("INSERT INTO Paper_Actuals_Zapper ( ID, [Year] ) SELECT Paper_Actuals.ID, Paper_Actuals.Year FROM Next_Reporting_Month INNER JOIN Paper_Actuals ON Next_Reporting_Month.[Reporting Year] = Paper_Actuals.Year;") |
0158 | DoCmd.RunSQL ("DELETE Paper_Actuals.* FROM Paper_Actuals_Zapper INNER JOIN Paper_Actuals ON (Paper_Actuals_Zapper.Year = Paper_Actuals.Year) AND (Paper_Actuals_Zapper.ID = Paper_Actuals.ID);") |
0159 | DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;") |
0160 | DoCmd.OpenQuery ("Actual_Hours_Temp_Zap") |
0161 | DoCmd.OpenQuery ("Actual_Hours_Temp_GEN") |
0162 | DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Add") |
0163 | 'Check no "orphan" actuals (current year - due to timesheet reference error, or deleted Papers) |
0164 | Set rsTableToRead = CurrentDb.OpenRecordset("Current_Year_Papers_Actuals_Check") |
0165 | If Not rsTableToRead.EOF Then |
0166 | DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Check") |
0167 | MsgBox ("Missing Paper(s) for Actuals Update from current year's Actuals") |
0168 | Stop |
0169 | End If |
0170 | 'Update Papers total actuals (using a dummy table) |
0171 | DoCmd.RunSQL ("UPDATE Papers SET Papers.[Actual - Total] = 0;") |
0172 | DoCmd.RunSQL ("INSERT INTO Paper_Actuals_Zapper ( ID, [Year], Hours ) SELECT Paper_Actuals.ID, 9999 AS Expr1, Sum(Paper_Actuals.Hours) AS SumOfHours FROM Paper_Actuals GROUP BY Paper_Actuals.ID, 9999;") |
0173 | DoCmd.RunSQL ("UPDATE Paper_Actuals_Zapper INNER JOIN Papers ON Paper_Actuals_Zapper.ID = Papers.ID SET Papers.[Actual - Total] = [Hours] WHERE (((Paper_Actuals_Zapper.Year)=9999));") |
0174 | DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;") |
0175 | DoCmd.OpenQuery ("Estimate - Update") |
0176 | DoCmd.OpenQuery ("Estimate - Update Outstanding") |
0177 | DoCmd.OpenQuery ("Estimate - Update Zeros From Actuals") |
0178 | 'Check no "orphan" actuals |
0179 | Set rsTableToRead = CurrentDb.OpenRecordset("Missing_Papers_For_Actuals") |
0180 | If Not rsTableToRead.EOF Then |
0181 | DoCmd.OpenQuery ("Missing_Papers_For_Actuals") |
0182 | MsgBox ("Missing Paper(s) for Actuals Update") |
0183 | Stop |
0184 | End If |
0185 | DoCmd.OpenQuery ("Notes_To_Print_Add") 'AMMENDED 20/03/22 - Set to non-current |
0186 | DoCmd.OpenQuery ("Notes_To_Print_Update") |
0187 | DoCmd.OpenQuery ("Books - Estimates") |
0188 | 'Update Books total actuals (using a dummy table) |
0189 | DoCmd.RunSQL ("UPDATE Books SET Books.[Actual - Total] = 0;") |
0190 | DoCmd.RunSQL ("INSERT INTO Paper_Actuals_Zapper ( ID, [Year], Hours ) SELECT Books.ID1, 9999 AS Expr1, Sum(Papers.[Actual - Total]) AS [SumOfActual - Total] FROM (Books INNER JOIN qryBooks ON Books.ID1 = qryBooks.ID1) INNER JOIN Papers ON qryBooks.IDs = Papers.Book GROUP BY Books.ID1, 9999 HAVING (((Sum(Papers.[Actual - Total]))>0));") |
0191 | DoCmd.RunSQL ("UPDATE Paper_Actuals_Zapper INNER JOIN Books ON Paper_Actuals_Zapper.ID = Books.ID1 SET Books.[Actual - Total] = [Hours] WHERE (((Paper_Actuals_Zapper.Year)=9999));") |
0192 | DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;") |
0193 | DoCmd.OpenQuery ("Estimate - Update Outstanding - Books") |
0194 | DoCmd.OpenQuery ("AuthorAndTitle_Update") |
0195 | DoCmd.OpenQuery ("Papers - Location Update") |
0196 | Find_Book_Paper_Links |
0197 | DoCmd.OpenQuery ("Paper_Books_Zap") |
0198 | DoCmd.OpenQuery ("Paper_Books_GEN") |
0199 | Regen_Book_Paper_Links |
0200 | Regen_Book_Book_Links |
0201 | Regen_Book_Note_Links |
0202 | Regen_Paper_Paper_Links |
0203 | Regen_Paper_Book_Links |
0204 | Regen_Paper_Note_Links |
0205 | Regen_Author_Book_Links |
0206 | Regen_Author_Paper_Links |
0207 | WebpageGenBooksRecent |
0208 | WebpageGenBooksRecentCategorised |
0209 | DoCmd.OpenQuery ("Authors_List_Authors_Table_Zap") |
0210 | DoCmd.OpenQuery ("Authors_List_Authors_Table_GEN") |
0211 | DoCmd.OpenQuery ("Authors_Add") |
0212 | Author_Display_Names_Convert |
0213 | DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap") |
0214 | DoCmd.OpenQuery ("Book_Abstracts_Changed") |
0215 | DoCmd.OpenQuery ("Book_Abstracts_Archive_Zap") |
0216 | DoCmd.OpenQuery ("Book_Abstracts_Archive_Add") |
0217 | DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap") |
0218 | 'Update table that shows to display Book rather than Paper |
0219 | DoCmd.OpenQuery ("Book_Paper_Solitons_Zap") |
0220 | DoCmd.OpenQuery ("Book_Paper_Solitons_GEN") |
0221 | '... Except where the solitary Paper has a different Author or Title to the Book |
0222 | DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Zap") |
0223 | DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Gen") |
0224 | DoCmd.OpenQuery ("Book_Paper_Solitons_Prune") |
0225 | 'Regenerate the triggers for Pages impacted by changed links |
0226 | strQuery = "DELETE Page_Regen.* FROM Page_Regen;" |
0227 | DoCmd.RunSQL (strQuery) |
0228 | DoCmd.OpenQuery ("Page_Regen_GEN") |
0229 | Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;") |
0230 | i = rsTableToRead.RecordCount |
0231 | If Question = vbYes Then 'Asked the Question at the beginning! |
0232 | DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;") |
0233 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;") |
0234 | Archive_Notes_Now = "No" |
0235 | Regenerate_the_Links = "No" |
0236 | Regen_Notes_Only = "Yes" |
0237 | CreateNotesWebPages ("Yes") |
0238 | strQuery = "DELETE Cross_Reference_Changes.*, Page_Regen.Called_Type FROM Page_Regen INNER JOIN Cross_Reference_Changes ON (Page_Regen.Calling_Type = Cross_Reference_Changes.Calling_Type) AND (Page_Regen.Called_ID = Cross_Reference_Changes.Called_ID) AND (Page_Regen.Called_Type = Cross_Reference_Changes.Called_Type) WHERE (((Page_Regen.Called_Type)=""N""));" |
0239 | DoCmd.RunSQL (strQuery) |
0240 | DoCmd.RunSQL ("DELETE * FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N""));") |
0241 | End If |
0242 | Set rsTableToRead = Nothing |
0243 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE (((Notes.ID)=1256)) OR (((Notes.ID)=822)) OR (((Notes.ID)=981)) OR (((Notes.ID)=1308)) OR (((Notes.ID)=1313)) OR (((Notes.ID)=1317)) OR (((Notes.ID)=1319));") |
0244 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Outstanding Developments (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=981)));") |
0245 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Progress to Date (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=822)));") |
0246 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Status: Oboe Practice (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=1308)));") |
0247 | DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;") |
0248 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1256));") 'Regenerate the "Dud Links" Note |
0249 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=822));") 'Regenerate the "Website - Progress to Date" Note |
0250 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note |
0251 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1308));") 'Regenerate the "Status: Oboe Practice" Note |
0252 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1313));") 'Regenerate the "Brief Thoughts on Language & Languages" Note |
0253 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1317));") 'Regenerate the "PID Note Usage" Note |
0254 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1319));") 'Regenerate the "PDFs Available on Local Website" Note |
0255 | Archive_Notes_Now = "No" |
0256 | Regenerate_the_Links = "No" |
0257 | Regen_Notes_Only = "Yes" |
0258 | CreateNotesWebPages ("Yes") |
0259 | Check_Types |
0260 | Cross_Reference_Changes_Prune |
0261 | Duration = Round((Now() - start) * 24 * 60, 2) |
0262 | If Duration < 1 Then |
0263 | Duration = Round(Duration * 60, 0) |
0264 | MsgBox "Recalculation Complete in " & Duration & " seconds.", vbOKOnly, "Recalculate" |
0265 | Else |
0266 | MsgBox "Recalculation Complete in " & Duration & " minutes.", vbOKOnly, "Recalculate" |
0267 | End If |
0268 | End Sub |