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 1 (59 items)

cmdAbstracts_ClickcmdArchive_ClickcmdArchivePaperSummaries_ClickcmdAudio_Click
cmdBackup_ClickcmdBookPaperAbstracts_ClickcmdBooks_ClickcmdBooksLocation_Click
cmdBooksOrdered_ClickcmdBooksTable_ClickcmdBooksToNotes_ClickcmdBooksToPapers_Click
cmdBooksTopic_ClickcmdChangedAbstracts_ClickcmdChangedPaperSummaries_ClickcmdCloseApplication_Click
cmdConcatenatedNotes_ClickcmdDevLog_ClickcmdDocumenter_ClickcmdElectronicResources_Click
cmdIdentityPapersFull_ClickcmdIdentityPapersFullSubTopic_ClickcmdIdentityPapersRead_ClickcmdIdentityPapersReadSubTopic_Click
cmdMissingTimesheet_ClickcmdMonthlyReports_ClickcmdMonthSummary_ClickcmdNearlyReadBooks_Click
cmdNotePaperLinksGen_ClickcmdNotes_ClickcmdNotes_To_Print_ClickcmdNotesBlog_Click
cmdNotesRenumber_ClickcmdNotesTable_ClickcmdNotesTableAuto_ClickcmdNotesTableBible_Click
cmdNotesTableReligion_ClickcmdNotesTableTemp_ClickcmdNotesTableTract_ClickcmdPaperSearchAuthor_Click
cmdPapersTable_ClickcmdPapersToNotes_ClickcmdPaperSummaries_ClickcmdPhilosophyPapersFull_Click
cmdPhilosophyPapersFullSubTopic_ClickcmdPhilosophyPapersFullTopic_ClickcmdPIAuthorAbstracts_ClickcmdPrecis_Click
cmdPrintNote_ClickcmdRecalculate_ClickcmdSearch_ClickcmdSearchAbstracts_Click
cmdSearchBooks_ClickcmdSearchNotes_ClickcmdSpider_ClickcmdSupervisions_Click
cmdUpdateAbstracts_ClickEndTimerQuery_Documenter.

To access information, click on one of the links in the table above.

Go to top of page



Source Code of: cmdAbstracts_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 6

Line-No. / Ref.Code Line
0001Private Sub cmdAbstracts_Click()
0002'Test_Flag = True
0003automatic_processing = "No"
0004RootCreated = ""
0005 CreateAbstractWebPages
0006End Sub

Procedures Called By This Procedure (cmdAbstracts_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdArchive_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 11

Line-No. / Ref.Code Line
0001Private Sub cmdArchive_Click()
0002If MsgBox("Before archiving Abstracts, ensure that ""Webpage - Abstracts"" is run first. Proceed?", vbYesNo) = vbNo Then
0003 Exit Sub
0004End If
0005 DoCmd.OpenQuery ("Abstracts_Archive_Temp_Zap")
0006 DoCmd.OpenQuery ("Abstracts_Changed")
0007 DoCmd.OpenQuery ("Abstracts_Archive_Zap")
0008 DoCmd.OpenQuery ("Abstracts_Archive_Add")
0009 DoCmd.OpenQuery ("Abstracts_Archive_Temp_Zap")
0010MsgBox ("Abstracts archived OK")
0011End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdArchive_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdArchivePaperSummaries_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 16

Line-No. / Ref.Code Line
0001Private Sub cmdArchivePaperSummaries_Click()
0002If MsgBox("Before archiving Paper & Book Summaries, ensure that ""Webpage - Paper + Book Summaries"" is run first. Proceed?", vbYesNo) = vbNo Then
0003 Exit Sub
0004End If
0005 DoCmd.OpenQuery ("Paper_Summary_Temp_Zap")
0006 DoCmd.OpenQuery ("Paper_Summary_Temp_GEN")
0007 DoCmd.OpenQuery ("Paper_Summary_Zap")
0008 DoCmd.OpenQuery ("Paper_Summary_GEN")
0009 DoCmd.OpenQuery ("Paper_Summary_Temp_Zap")
0010 DoCmd.OpenQuery ("Book_Summary_Temp_Zap")
0011 DoCmd.OpenQuery ("Book_Summary_Temp_GEN")
0012 DoCmd.OpenQuery ("Book_Summary_Zap")
0013 DoCmd.OpenQuery ("Book_Summary_GEN")
0014 DoCmd.OpenQuery ("Book_Summary_Temp_Zap")
0015MsgBox ("Paper + BookSummaries archived OK")
0016End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdArchivePaperSummaries_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdAudio_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub cmdAudio_Click()
0002 DoCmd.OpenTable ("Audio_Files")
0003 DoCmd.OpenTable ("Oboe_Practice_Hours")
0004End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdAudio_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBackup_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 34
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdBackup_Click()
0002Dim Start_Time As Date
0003Dim Backup_Option As String
0004Dim Option_Help As String
0005Option_Help = "1. Back-up the system"
0006Option_Help = Option_Help & Chr$(10) & "2. De-duplicate the backup disk"
0007 Option_Help = Option_Help & Chr$(10) & "3. Search the ""Backup_Site_Map"" table"
0008 Option_Help = Option_Help & Chr$(10) & "4. Search the ""Full_Backup_Site_Map"" table"
0009Backup_Option = InputBox(Option_Help, "Enter an integer Backup Option", 1)
0010If Len(Backup_Option) = 0 Then
0011 End
0012End If
0013If Backup_Option < "1" Or Backup_Option > "5" Then
0014 MsgBox ("Choose an Option between 1 and 5")
0015 End
0016End If
0017Start_Time = Now()
0018Select Case Backup_Option
0019 Case 1
0020 DoCmd.OpenTable ("Backup_Control")
0021 DoCmd.OpenTable ("Backup_Directory_Structure")
0022 DoCmd.OpenTable ("Backup_Site_Map")
0023 Backup_Ctrl
0024 Case 2
0025 Backup_Prune_Ctrl
0026 MsgBox ("Backup Disk de-duplicated successfully in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0027 Case 3
0028 DoCmd.OpenQuery ("Backup_Site_Map_Search")
0029 Case 4
0030 DoCmd.OpenQuery ("Full_Backup_Site_Map_Search")
0031 Case Else
0032 End
0033End Select
0034End Sub

Procedures Called By This Procedure (cmdBackup_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdBackup_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBookPaperAbstracts_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 9

Line-No. / Ref.Code Line
0001Private Sub cmdBookPaperAbstracts_Click()
0002RootCreated = ""
0003If MsgBox("Do you want to regenerate the ""Printable Book Paper Abstracts"" pages?", vbYesNo) = vbYes Then
0004 automatic_processing = "No"
0005 WebpageGenBookPaperAbstractsWebPages
0006Else
0007 Exit Sub
0008End If
0009End Sub

Procedures Called By This Procedure (cmdBookPaperAbstracts_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooks_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 29
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdBooks_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim rsTableToRead2 As Recordset
0006Dim Duration As Double
0007Dim RunTime As Single
0008Dim RunDate As Date
0009 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenBooks"";")
0010RunDate = rsTableToRead.Fields(1)
0011RunTime = rsTableToRead.Fields(2)
0012 strMessage = "Do you want to regenerate the ""Books"" page?"""
0013strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & RunTime & " minutes."
0014RootCreated = ""
0015If MsgBox(strMessage, vbYesNo) = vbYes Then
0016 StartTime = Now()
0017 WebpageGenBooks
0018 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0019 rsTableToRead.Edit
0020 rsTableToRead.Fields(1) = Now()
0021 rsTableToRead.Fields(2) = Duration
0022 rsTableToRead.Update
0023Else
0024 Exit Sub
0025End If
0026MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0027Set rsTableToRead = Nothing
0028Set rsTableToRead2 = Nothing
0029End Sub

Procedures Called By This Procedure (cmdBooks_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdBooks_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooksLocation_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdBooksLocation_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenBooksLocation"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011strMessage = "Do you want to regenerate the ""Books by Location"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenBooksLocation
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdBooksLocation_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdBooksLocation_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooksOrdered_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub cmdBooksOrdered_Click()
0002 DoCmd.OpenQuery ("Booklist - On Order")
0003 DoCmd.OpenQuery ("Papers_On_Order")
0004End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdBooksOrdered_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooksTable_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdBooksTable_Click()
0002 DoCmd.OpenTable ("Books")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdBooksTable_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooksToNotes_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 44
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdBooksToNotes_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim rsTableToRead2 As Recordset
0006Dim Duration As Double
0007Dim strRunTime As String
0008Dim RunDate As Date
0009Dim strControlQuery As String
0010 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenBooksToNotes"";")
0011RunDate = rsTableToRead.Fields(1)
0012strRunTime = Round(rsTableToRead.Fields(2), 1)
0013RootCreated = ""
0014 strMessage = "Do you want to regenerate the ""Note_Book_Links"" table? This is used in Note Reading Lists only. """
0015If MsgBox(strMessage, vbYesNo) = vbYes Then
0016 'Code below deleted Feb 5, 2022 ... now uses Cross_Reference table only ... but re-instated on 17/06/22 as needed for the Note References & Reading List section
0017 StartTime = Now()
0018 'Note_Book_Links - Live Notes
0019 strControlQuery = "SELECT Notes.ID, Notes.Item_Text, 0 AS x FROM Notes;"
0020 Set rsTableToRead2 = CurrentDb.OpenRecordset(strControlQuery)
0021 OK = Regen_Note_Book_Links(rsTableToRead2, 0, 1, 2)
0022 'Note_Book_Links - Archived Notes
0023 strControlQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text, Notes_Archive.[Timestamp] FROM Notes_Archive;"
0024 Set rsTableToRead2 = CurrentDb.OpenRecordset(strControlQuery)
0025 OK = Regen_Note_Book_Links(rsTableToRead2, 0, 1, 2)
0026End If
0027Duration = Round((Now() - StartTime) * 24 * 60, 1)
0028MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0029 strMessage = "Do you want to regenerate the ""Books To Notes Links"" pages?"""
0030strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0031If MsgBox(strMessage, vbYesNo) = vbYes Then
0032 StartTime = Now()
0033 WebpageGenBooksToNotes
0034 WebpageGenNoteBooksLinks
0035 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0036 rsTableToRead.Edit
0037 rsTableToRead.Fields(1) = Now()
0038 rsTableToRead.Fields(2) = Duration
0039 rsTableToRead.Update
0040 MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0041End If
0042Set rsTableToRead = Nothing
0043Set rsTableToRead2 = Nothing
0044End Sub

Procedures Called By This Procedure (cmdBooksToNotes_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdBooksToNotes_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooksToPapers_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 19

Line-No. / Ref.Code Line
0001Private Sub cmdBooksToPapers_Click()
0002Dim RunStartTime As Date
0003Dim Duration As Single
0004RootCreated = ""
0005If MsgBox("Do you want to regenerate the ""Books To Papers Links"" pages?", vbYesNo) = vbYes Then
0006 RunStartTime = Now()
0007 WebpageGenBooksToPapers
0008Else
0009 Exit Sub
0010End If
0011Duration = (Now() - RunStartTime) * 24 * 60
0012If Duration < 1 Then
0013 Duration = Round(Duration * 60)
0014 MsgBox Now() & ": Books To Papers Links Webpage Creation Complete in " & Duration & " seconds. ", vbOKOnly, "Create Books To Papers Links Webpages"
0015Else
0016 Duration = Round(Duration, 1)
0017 MsgBox Now() & ": Books To Papers Links Webpage Creation Complete in " & Duration & " minutes. ", vbOKOnly, "Create Books To Papers Links Webpages"
0018End If
0019End Sub

Procedures Called By This Procedure (cmdBooksToPapers_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdBooksTopic_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdBooksTopic_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenBooksCategorised"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011strMessage = "Do you want to regenerate the ""Books Categorised"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenBooksCategorised
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdBooksTopic_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdBooksTopic_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdChangedAbstracts_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdChangedAbstracts_Click()
0002 DoCmd.OpenQuery ("Abstracts_Changed_List")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdChangedAbstracts_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdChangedPaperSummaries_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 8

Line-No. / Ref.Code Line
0001Private Sub cmdChangedPaperSummaries_Click()
0002 DoCmd.OpenQuery ("Paper_Summary_Changed_List")
0003 DoCmd.OpenQuery ("Book_Summary_Changed_List")
0004 DoCmd.OpenQuery ("Authors_List_Changed")
0005 DoCmd.OpenQuery ("Book_Citings_List_Changed")
0006 DoCmd.OpenQuery ("Paper_Citings_List_Changed")
0007 DoCmd.OpenTable ("System_Parameters")
0008End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdChangedPaperSummaries_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdCloseApplication_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdCloseApplication_Click()
0002DoCmd.Quit
0003End Sub

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdConcatenatedNotes_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 9

Line-No. / Ref.Code Line
0001Private Sub cmdConcatenatedNotes_Click()
0002RootCreated = ""
0003If MsgBox("Do you want to regenerate the Concatenated Note Group Web Pages?", vbYesNo) = vbYes Then
0004 automatic_processing = "No"
0005 WebpageGenConcatenatedNoteGroupWebPages
0006Else
0007 Exit Sub
0008End If
0009End Sub

Procedures Called By This Procedure (cmdConcatenatedNotes_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdDevLog_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 110
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdDevLog_Click()
0002Dim x As String
0003Dim rsTableControl As Recordset
0004Dim strMessage As String
0005Dim strQuery As String
0006Dim i As Integer
0007Dim strDevelopment As String
0008Dim Problem As Boolean
0009'Check for data conditions that would cause problems in reporting ...
0010 Set rsTableControl = CurrentDb.OpenRecordset("Dud_Devlog_Descriptions")
0011If Not rsTableControl.EOF Then
0012 MsgBox ("Development text cannot contain ""|99|"" or ""|##|""")
0013 DoCmd.OpenQuery ("Dud_Devlog_Descriptions")
0014 End
0015End If
0016 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Development FROM Development_Log WHERE Development LIKE ""*|..|*"";")
0017If 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
0045End If
0046strMessage = "Display the Development Log? Choose from the numeric options below:-" & Chr(10)
0047strMessage = strMessage & Chr(10) & "01. Full List by Category"
0048strMessage = strMessage & Chr(10) & "02. All Complete by Date"
0049strMessage = strMessage & Chr(10) & "03. Others Complete by Date within Category"
0050strMessage = strMessage & Chr(10) & "04. Own Complete by Date within Category"
0051strMessage = strMessage & Chr(10) & "05. Others Outstanding by Category"
0052strMessage = strMessage & Chr(10) & "06. Others Outstanding by Category - Pri 1"
0053strMessage = strMessage & Chr(10) & "07. Others Outstanding by Priority"
0054strMessage = strMessage & Chr(10) & "08. Own Outstanding by Priority within Category"
0055strMessage = strMessage & Chr(10) & "09. Own Outstanding by Category - Pri 1"
0056strMessage = strMessage & Chr(10) & "10. Own Outstanding by Category within Priority"
0057strMessage = strMessage & Chr(10) & "11. Search"
0058strMessage = strMessage & Chr(10) & "12. Output Development Log Web Pages"
0059x = InputBox(strMessage, "Choose a Development Log Option")
0060If x = "" Then
0061 Exit Sub
0062End If
0063If Not IsNumeric(x) Then
0064 Exit Sub
0065Else
0066 i = x
0067End If
0068strQuery = ""
0069Select 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, [Timestamp] ) SELECT Notes.ID, Int(Now() * 1000) AS X FROM Notes WHERE (((Notes.ID)=822));") 'Regenerate the "Website - Progress to Date" Note
0098 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID, [Timestamp] ) SELECT Notes.ID, Int(Now() * 1000) AS X FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note
0099 DoCmd.OpenQuery ("Temp_Note_Timestamp_Update") 'Added October 2024 ... to give better indication of the latest changed date for Temp Notes (to protect against 'Full Regen' date for temp notes)
0100 Archive_Notes_Now = "No"
0101 Regenerate_the_Links = "No"
0102 Regen_Notes_Only = "Yes"
0103 CreateNotesWebPages ("Yes")
0104 MsgBox ("Development Log Web Pages Output OK")
0105 Exit Sub
0106 Case Else
0107 Exit Sub
0108End Select
0109DoCmd.OpenQuery (strQuery)
0110End Sub

Procedures Called By This Procedure (cmdDevLog_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdDevLog_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdDocumenter_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 92
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdDocumenter_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008Dim MsgboxMsg As String
0009Dim Get_Going As Boolean
0010NoReusedQueryNames = 0
0011NoAmbiguousNames = 0
0012NoImages = 0
0013NoUnusedQueries = 0
0014NoUnusedVariables = 0
0015NoDeletedQueries = 0
0016NoNameClashes = 0
0017NoDevelopmentLogItems = 0
0018SubSystem = ""
0019 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""Documentation_Generator"";")
0020RunDate = rsTableToRead.Fields(1)
0021strRunTime = Round(rsTableToRead.Fields(2), 1)
0022strMessage = "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")
0023strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0024RootCreated = ""
0025Get_Going = False
0026If MsgBox(strMessage, vbYesNo) = vbYes Then
0027Else
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
0039End If
0040StartTime = Now()
0041 Documentation_Generator
0042Duration = Round((Now() - StartTime) * 24 * 60, 1)
0043rsTableToRead.Edit
0044rsTableToRead.Fields(1) = Now()
0045rsTableToRead.Fields(2) = Duration
0046rsTableToRead.Update
0047MsgboxMsg = ""
0048MsgboxMsg = MsgboxMsg & "There are " & NoDevelopmentLogItems & " items in the Development Log." & Chr$(10)
0049If NoDeletedQueries = 0 Then
0050Else
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
0056End If
0057If NoUnusedVariables <> 0 Then
0058 MsgboxMsg = MsgboxMsg & "There are " & NoUnusedVariables & " allegedly unused Variables in the database." & Chr$(10)
0059End If
0060MsgboxMsg = MsgboxMsg & "There are " & NoImages & " Images allegedly on my website. " & Chr$(10)
0061MsgboxMsg = MsgboxMsg & "There are " & NoUnusedQueries & " allegedly unused Queries in the database." & Chr$(10)
0062If NoAmbiguousNames = 0 Then
0063Else
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)
0070End If
0071If NoNameClashes = 0 Then
0072Else
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)
0079End If
0080If NoReusedQueryNames = 0 Then
0081Else
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)
0088End If
0089MsgboxMsg = MsgboxMsg & Chr$(10) & Chr$(10)
0090MsgBox (MsgboxMsg & "The lists follow ... Investigate them and consider pruning. " & Chr$(10) & Chr$(10) & "Documentation Complete in " & Duration & " minutes.")
0091Set rsTableToRead = Nothing
0092End Sub

Procedures Called By This Procedure (cmdDocumenter_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdDocumenter_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdElectronicResources_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdElectronicResources_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenElectronicResources"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Electronic Resources"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenElectronicResources
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025Set rsTableToRead = Nothing
0026MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0027End Sub

Procedures Called By This Procedure (cmdElectronicResources_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdElectronicResources_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdIdentityPapersFull_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdIdentityPapersFull_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenIdentityPapersFull"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Identity Papers Full"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenIdentityPapersFull
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdIdentityPapersFull_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdIdentityPapersFull_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdIdentityPapersFullSubTopic_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdIdentityPapersFullSubTopic_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenIdentityPapersFullSubtopic"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Identity Papers Full (Sub-Topic)"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenIdentityPapersFullSubtopic
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdIdentityPapersFullSubTopic_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdIdentityPapersFullSubTopic_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdIdentityPapersRead_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdIdentityPapersRead_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenIdentityPapersRead"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Identity Papers Read"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenIdentityPapersRead
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025Set rsTableToRead = Nothing
0026MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0027End Sub

Procedures Called By This Procedure (cmdIdentityPapersRead_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdIdentityPapersRead_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdIdentityPapersReadSubTopic_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdIdentityPapersReadSubTopic_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenIdentityPapersReadSubTopics"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Identity Papers Read (Sub-Topic)"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenIdentityPapersReadSubTopics
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdIdentityPapersReadSubTopic_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdIdentityPapersReadSubTopic_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdMissingTimesheet_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdMissingTimesheet_Click()
0002 DoCmd.OpenQuery ("Missing Priority Tasks For Timesheet")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdMissingTimesheet_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdMonthlyReports_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdMonthlyReports_Click()
0002 Monthly_Reporting
0003End Sub

Procedures Called By This Procedure (cmdMonthlyReports_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdMonthSummary_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 90
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdMonthSummary_Click()
0002'These are actually the Quarterly & YTD detailed reports (and the Priority Task List)!
0003Dim Quarterly As Boolean
0004Dim Annual As Boolean
0005Dim Priority As Boolean
0006Dim Start_Time As Date
0007Dim strMsg As String
0008Dim rsTableControl As Recordset
0009 DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE (((Notes.ID)=1266)) OR (((Notes.ID)=1275)) OR (((Notes.ID)=975));")
0010If 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
0068Else
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
0073End If
0074If 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.")
0089End If
0090End Sub

Procedures Called By This Procedure (cmdMonthSummary_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdMonthSummary_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNearlyReadBooks_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdNearlyReadBooks_Click()
0002 DoCmd.OpenQuery ("Books_Nearly_Read")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNearlyReadBooks_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotePaperLinksGen_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 15

Line-No. / Ref.Code Line
0001Private Sub cmdNotePaperLinksGen_Click()
0002Dim StartTime As Date
0003Dim strControlQuery As String
0004Dim rsTableToRead As Recordset
0005If MsgBox("Do you want to regenerate the Note_Paper_Links table?", vbYesNo) = vbYes Then
0006 StartTime = Now()
0007 'Read the regenerated Notes
0008 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;"
0009 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0010 OK = Regen_Note_Paper_Links(rsTableToRead, 0, 2, 12)
0011 MsgBox "Note_Paper_Links table Creation Complete, in " & Round((Now() - StartTime) * 24 * 60, 1) & " minutes.", vbOKOnly, "Create Note_Paper_Links"
0012Else
0013 Exit Sub
0014End If
0015End Sub

Procedures Called By This Procedure (cmdNotePaperLinksGen_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdNotePaperLinksGen_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotes_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 359
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdNotes_Click()
0002Dim rsTableControl As Recordset
0003Dim rsTableToRead As Recordset
0004Dim rs As Recordset
0005Dim First_Note_To_Regen As String
0006Dim Regen_Blurb As String
0007Dim i As Integer
0008Dim j As Integer
0009Dim Temp_Note_ID
0010Dim Start_Note_ID As Integer
0011Dim End_Note_ID As Integer
0012Dim strControlQuery As String
0013Dim strMessage As String
0014Dim StartTime As Date
0015Dim RunStartTime As Date
0016Dim Duration As Double
0017Dim Response As String
0018Dim Total_Run As Single
0019Dim Run_Type As String
0020Dim RunDate As Date
0021Dim NumberOfRows As Integer
0022Dim RowCount As Integer
0023Dim StopRows As Boolean
0024Dim Etc_Message As String
0025Dim Option_Help As String
0026Dim Notes_Option As String
0027If 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
0075End If
0076RootCreated = ""
0077If MsgBox("Do you want to regenerate Notes Web-pages?", vbYesNo) <> vbYes Then
0078 Exit Sub
0079End If
0080Run_Type = ""
0081Temp_Notes_Only = "No"
0082Changed_Notes_Only = "No"
0083Include_Associated_Notes = "No"
0084Regen_Notes_Only = "No"
0085Regenerate_the_Links = "No"
0086Archive_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]);")
0089First_Note_To_Regen = 0
0090i = 0
0091If Not rsTableControl.EOF Then
0092 rsTableControl.MoveFirst
0093 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0094 i = rsTableControl.RecordCount
0095End If
0096If i = 0 Then
0097 Regen_Blurb = ""
0098Else
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
0118End If
0119If 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 rsTableControl.Fields(1) = Int(Now() * 1000)
0138 On Error Resume Next
0139 rsTableControl.Update
0140 If Err.Number = 3022 Then
0141 MsgBox ("Duplicate Note (" & Temp_Note_ID & ") selected")
0142 End If
0143 Err.Number = 0
0144 End If
0145 Loop
0146 'Check whether we got it right!
0147 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]);")
0148 First_Note_To_Regen = 0
0149 i = 0
0150 If Not rsTableControl.EOF Then
0151 rsTableControl.MoveFirst
0152 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0153 i = rsTableControl.RecordCount
0154 End If
0155 If i = 0 Then
0156 Regen_Blurb = ""
0157 Else
0158 If i = 1 Then
0159 Regen_Blurb = "Do you want to select this Note? The Note is " & First_Note_To_Regen & ")."
0160 Else
0161 If i > 9 Then
0162 Regen_Blurb = "The first 10 Notes (of " & i & ") are:-" & Chr$(10)
0163 Else
0164 Regen_Blurb = "The " & i & " Notes are:-" & Chr$(10)
0165 End If
0166 For j = 1 To 10
0167 If rsTableControl.EOF Then
0168 j = 11
0169 Else
0170 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0171 Regen_Blurb = Regen_Blurb & IIf(j = 1, "", ",") & Chr$(10) & "..." & rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) & ")"
0172 rsTableControl.MoveNext
0173 End If
0174 Next j
0175 Regen_Blurb = "Do you want to select these Notes? " & Regen_Blurb
0176 End If
0177 End If
0178 If i > 0 Then
0179 If MsgBox(Regen_Blurb, vbYesNo) <> vbYes Then
0180 MsgBox ("Try again then!")
0181 Exit Sub
0182 Else
0183 DoCmd.OpenQuery ("Temp_Note_Timestamp_Update") 'Added October 2024 ... to give better indication of the latest changed date for Temp Notes (to protect against 'Full Regen' date for temp notes)
0184 End If
0185 End If
0186 End If
0187Else
0188 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0189 If MsgBox("Do you want to regenerate ranges of Notes based on the Note_Regen_Ranges table?", vbYesNo + vbDefaultButton2) = vbYes Then
0190 Regen_Notes_Only = "Yes"
0191 Run_Type = "Ranges"
0192 Etc_Message = " ... Etc. " & Chr(10)
0193 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0194 If Not rsTableToRead.EOF Then
0195 rsTableToRead.MoveFirst
0196 NumberOfRows = rsTableToRead.RecordCount
0197 RowCount = 0
0198 StopRows = False
0199 strMessage = "Run for the following range" & IIf(rsTableToRead.RecordCount > 1, "s", "") & "?" & Chr(10) & Chr(10)
0200 Do While Not rsTableToRead.EOF
0201 RowCount = RowCount + 1
0202 If RowCount < 15 Then
0203 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)
0204 Else
0205 If StopRows = False Then
0206 If NumberOfRows > 20 Then
0207 StopRows = True
0208 strMessage = strMessage & Etc_Message
0209 Else
0210 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)
0211 End If
0212 End If
0213 End If
0214 Total_Run = Total_Run + Nz(rsTableToRead.Fields(5))
0215 rsTableToRead.MoveNext
0216 Loop
0217 strMessage = strMessage & "Total time = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0218 Else
0219 DoCmd.OpenTable ("Note_Regen_Ranges")
0220 MsgBox ("No Ranges selected. Update the Note_Regen_Ranges Table.")
0221 End
0222 End If
0223 Total_Run = 0
0224 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = False ORDER BY ID_Start;")
0225 If Not rsTableToRead.EOF Then
0226 NumberOfRows = NumberOfRows + rsTableToRead.RecordCount
0227 strMessage = strMessage & "Not selected:- " & Chr(10) & Chr(10)
0228 rsTableToRead.MoveFirst
0229 Do While Not rsTableToRead.EOF
0230 RowCount = RowCount + 1
0231 If StopRows = False Then
0232 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)
0233 End If
0234 If RowCount > 18 Then
0235 If NumberOfRows > 20 Then
0236 StopRows = True
0237 strMessage = strMessage & Etc_Message
0238 Etc_Message = ""
0239 End If
0240 End If
0241 Total_Run = Total_Run + rsTableToRead.Fields(5)
0242 rsTableToRead.MoveNext
0243 Loop
0244 strMessage = strMessage & "Total time outstanding = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0245 End If
0246 Response = MsgBox(strMessage, vbYesNo)
0247 If Response = vbNo Then
0248 DoCmd.OpenTable ("Note_Regen_Ranges")
0249 MsgBox ("Update the Note_Regen_Ranges Table.")
0250 End
0251 Else
0252 RunStartTime = Now()
0253 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0254 If Not rsTableToRead.EOF Then
0255 rsTableToRead.MoveFirst
0256 StartTime = Now()
0257 Do While Not rsTableToRead.EOF
0258 'Clear Notes_To_Regen table & ready for inserts
0259 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0260 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0261 'Update the table
0262 Start_Note_ID = rsTableToRead.Fields(1)
0263 End_Note_ID = rsTableToRead.Fields(2)
0264 For Temp_Note_ID = Start_Note_ID To End_Note_ID
0265 rsTableControl.AddNew
0266 rsTableControl.Fields(0) = Temp_Note_ID
0267 rsTableControl.Update
0268 Next Temp_Note_ID
0269 automatic_processing = "Yes"
0270 CreateNotesWebPages
0271 'Update the control table
0272 Duration = Now() - StartTime
0273 Duration = Duration * 24 * 60
0274 Duration = Round(Duration, 1)
0275 RunDate = Now()
0276 rsTableToRead.Edit
0277 rsTableToRead.Fields(4) = RunDate
0278 rsTableToRead.Fields(5) = Duration
0279 rsTableToRead.Update
0280 StartTime = Now()
0281 rsTableToRead.MoveNext
0282 Loop
0283 End If
0284 End If
0285 Else
0286 If MsgBox("Do you want to regenerate a bespoke range of Notes?", vbYesNo + vbDefaultButton2) = vbYes Then
0287 Regen_Notes_Only = "Yes"
0288 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0289 Temp_Note_ID = InputBox("Enter Start Note ID")
0290 Temp_Note_ID = Val(Temp_Note_ID)
0291 If Temp_Note_ID > 0 Then
0292 Start_Note_ID = Temp_Note_ID
0293 Temp_Note_ID = InputBox("Enter End Note ID")
0294 Temp_Note_ID = Val(Temp_Note_ID)
0295 If Temp_Note_ID > 0 Then
0296 If Temp_Note_ID > Start_Note_ID Then
0297 End_Note_ID = Temp_Note_ID
0298 For Temp_Note_ID = Start_Note_ID To End_Note_ID
0299 rsTableControl.AddNew
0300 rsTableControl.Fields(0) = Temp_Note_ID
0301 rsTableControl.Update
0302 Next Temp_Note_ID
0303 End If
0304 End If
0305 End If
0306 End If
0307 End If
0308End If
0309If Run_Type = "Ranges" Then
0310 GoTo The_End
0311End If
0312'Check for individually-selected or range-selected Notes
0313 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;"
0314Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0315If Not rsTableToRead.EOF Then
0316 Regen_Notes_Only = "Yes"
0317 If MsgBox("Regenerate the Links?", vbYesNo + vbDefaultButton2) = vbYes Then
0318 Regenerate_the_Links = "Yes"
0319 End If
0320Else
0321 Regenerate_the_Links = "Yes"
0322 Archive_Notes_Now = "Yes"
0323 'Check if only doing Temp Notes - Read Temp Notes records
0324 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Status = ""Temp"" ORDER BY Notes_List_Auto.ID;"
0325 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0326 If Not rsTableToRead.EOF Then
0327 If MsgBox("Temp Notes only?", vbYesNo + vbDefaultButton2) = vbYes Then
0328 Archive_Notes_Now = "No"
0329 Temp_Notes_Only = "Yes"
0330 GoTo Create_Notes
0331 End If
0332 End If
0333 If MsgBox("Changed Notes only?", vbYesNo) = vbYes Then
0334 Changed_Notes_Only = "Yes"
0335 If MsgBox("Include Notes Linked to Changed Notes?", vbYesNo + vbDefaultButton2) = vbYes Then
0336 Include_Associated_Notes = "Yes"
0337 End If
0338 End If
0339End If
0340Create_Notes:
0341'Final Check ..
0342Regen_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"". "
0343If MsgBox(Regen_Blurb, vbOKCancel) = vbCancel Then
0344 Exit Sub
0345Else
0346 automatic_processing = "No"
0347 CreateNotesWebPages
0348End If
0349The_End:
0350If Run_Type = "Ranges" Then
0351 Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0352 If Duration < 1 Then
0353 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0354 MsgBox "Note Ranges Regeneration Complete in " & Duration & " seconds.", vbOKOnly, "Create Notes Webpages"
0355 Else
0356 MsgBox "Note Ranges Regeneration Complete in " & Duration & " minutes.", vbOKOnly, "Create Notes Webpages"
0357 End If
0358End If
0359End Sub

Procedures Called By This Procedure (cmdNotes_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdNotes_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotes_To_Print_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 15

Line-No. / Ref.Code Line
0001Private Sub cmdNotes_To_Print_Click()
0002Dim x As String
0003x = MsgBox("Do you want to display the whole ""Notes_To_Print"" table?", vbYesNoCancel)
0004If x = vbYes Then
0005 DoCmd.OpenTable ("Notes_To_Print")
0006Else
0007 If x = vbNo Then
0008 DoCmd.OpenQuery ("Notes_To_Print_List")
0009 End If
0010End If
0011If MsgBox("Do you want to display items from the ""Notes_Archive"" table?", vbYesNo) = vbYes Then
0012 DoCmd.OpenQuery ("Notes_Archive_List")
0013Else
0014End If
0015End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNotes_To_Print_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesBlog_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 2

Line-No. / Ref.Code Line
0001Private Sub cmdNotesBlog_Click()
0002End Sub

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesRenumber_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdNotesRenumber_Click()
0002MsgBox "Application not built yet", vbOKOnly, "Notes Renumber"
0003End Sub

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesTable_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub cmdNotesTable_Click()
0002 DoCmd.OpenTable ("Notes")
0003 DoCmd.OpenTable ("Sub_Notes")
0004End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNotesTable_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesTableAuto_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 12

Line-No. / Ref.Code Line
0001Private Sub cmdNotesTableAuto_Click()
0002'Update Stats
0003 DoCmd.OpenQuery ("Book_Location_Stats_Temp_Zap")
0004 DoCmd.OpenQuery ("Book_Location_Stats_Temp_GEN")
0005 DoCmd.OpenQuery ("Locations_Stats_Zap")
0006 DoCmd.OpenQuery ("Locations_Stats_Update")
0007 DoCmd.OpenQuery ("BookSummaryCountCostLocation")
0008 DoCmd.OpenQuery ("Books - Move")
0009 DoCmd.OpenTable ("Locations")
0010 DoCmd.OpenQuery ("Book_Paper_Filing")
0011 DoCmd.OpenQuery ("Authors_List_Fix")
0012End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNotesTableAuto_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesTableBible_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdNotesTableBible_Click()
0002 DoCmd.OpenQuery ("Notes_Bible")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNotesTableBible_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesTableReligion_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 2

Line-No. / Ref.Code Line
0001Private Sub cmdNotesTableReligion_Click()
0002End Sub

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesTableTemp_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 9

Line-No. / Ref.Code Line
0001Private Sub cmdNotesTableTemp_Click()
0002Dim rs As Recordset
0003 DoCmd.OpenQuery ("Notes_Temp")
0004 Set rs = CurrentDb.OpenRecordset("Sub_Notes_Temp")
0005If Not rs.EOF Then
0006 DoCmd.OpenQuery ("Sub_Notes_Temp")
0007End If
0008Set rs = Nothing
0009End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNotesTableTemp_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdNotesTableTract_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdNotesTableTract_Click()
0002 DoCmd.OpenQuery ("Notes_Tractatus")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdNotesTableTract_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPaperSearchAuthor_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdPaperSearchAuthor_Click()
0002 DoCmd.OpenQuery ("Papers - Abstracts - Author (Search)")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdPaperSearchAuthor_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPapersTable_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdPapersTable_Click()
0002 DoCmd.OpenTable ("Papers")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdPapersTable_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPapersToNotes_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 45
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdPapersToNotes_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim rsTableToRead2 As Recordset
0006Dim Duration As Double
0007Dim strRunTime As String
0008Dim RunDate As Date
0009Dim strControlQuery As String
0010 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenPapersToNotes"";")
0011RunDate = rsTableToRead.Fields(1)
0012strRunTime = Round(rsTableToRead.Fields(2), 1)
0013Duration = 0
0014RootCreated = ""
0015 strMessage = "Do you want to regenerate the ""Note_Paper_Links"" table? This is used in Note Reading Lists only. """
0016If MsgBox(strMessage, vbYesNo) = vbYes Then
0017 'Code below deleted Feb 5, 2022 ... now uses Cross_Reference table only ... but re-instated on 17/06/22 as needed for the Note References & Reading List section
0018 'Note_Paper_Links - Live Notes
0019 StartTime = Now()
0020 strControlQuery = "SELECT Notes.ID, Notes.Item_Text, 0 AS x FROM Notes;"
0021 Set rsTableToRead2 = CurrentDb.OpenRecordset(strControlQuery)
0022 OK = Regen_Note_Paper_Links(rsTableToRead2, 0, 1, 2)
0023 'Note_Paper_Links - Archived Notes
0024 strControlQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text, Notes_Archive.[Timestamp] FROM Notes_Archive;"
0025 Set rsTableToRead2 = CurrentDb.OpenRecordset(strControlQuery)
0026 OK = Regen_Note_Paper_Links(rsTableToRead2, 0, 1, 2)
0027 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0028 MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0029End If
0030 strMessage = "Do you want to regenerate the ""Papers To Notes Links"" pages?"""
0031strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0032If MsgBox(strMessage, vbYesNo) = vbYes Then
0033 StartTime = Now()
0034 WebpageGenPapersToNotes
0035 WebpageGenNotePapersLinks
0036 Duration = Duration + Round((Now() - StartTime) * 24 * 60, 1)
0037 rsTableToRead.Edit
0038 rsTableToRead.Fields(1) = Now()
0039 rsTableToRead.Fields(2) = Duration
0040 rsTableToRead.Update
0041 MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0042End If
0043Set rsTableToRead = Nothing
0044Set rsTableToRead2 = Nothing
0045End Sub

Procedures Called By This Procedure (cmdPapersToNotes_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdPapersToNotes_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPaperSummaries_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 33
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdPaperSummaries_Click()
0002'Routine called from the front page - wrongly named as it now covers Authors, Books and Papers
0003Dim strMsg As String
0004Dim Duration As Double
0005Dim RunStartTime As Date
0006'Test_Flag = True
0007strMsg = "Do you want to do all the changes without answering further questions?"
0008If MsgBox(strMsg, vbYesNo) = vbYes Then
0009 automatic_processing = "Yes"
0010Else
0011 automatic_processing = "No"
0012End If
0013RunStartTime = Now()
0014 WebpageGenAuthors
0015 WebpageGenBookCitings
0016 WebpageGenPaperCitings
0017RootCreated = ""
0018If automatic_processing = "Yes" Then
0019 automatic_processing = "No"
0020 CreatePaperSummariesWebPages ("Yes")
0021 CreateBookSummariesWebPages ("Yes")
0022Else
0023 CreatePaperSummariesWebPages
0024 CreateBookSummariesWebPages
0025End If
0026Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0027If Duration < 1 Then
0028 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0029 MsgBox Now() & ": Author, Book & Paper Webpage Creation Complete in " & Duration & " seconds. ", vbOKOnly, "Create Paper Abstract Web Pages"
0030Else
0031 MsgBox Now() & ": Author, Book & Paper Webpage Creation Complete in " & Duration & " minutes. ", vbOKOnly, "Create Paper Abstract Web Pages"
0032End If
0033End Sub

Procedures Called By This Procedure (cmdPaperSummaries_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPhilosophyPapersFull_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 29
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdPhilosophyPapersFull_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim rsTableToRead2 As Recordset
0006Dim Duration As Double
0007Dim RunTime As Single
0008Dim RunDate As Date
0009 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenPhilosophyPapersFull"";")
0010RunDate = rsTableToRead.Fields(1)
0011RunTime = rsTableToRead.Fields(2)
0012 strMessage = "Do you want to regenerate the ""Philosophy Papers Full"" page?"""
0013strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & RunTime & " minutes."
0014RootCreated = ""
0015If MsgBox(strMessage, vbYesNo) = vbYes Then
0016 StartTime = Now()
0017 WebpageGenPhilosophyPapersFull
0018 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0019 rsTableToRead.Edit
0020 rsTableToRead.Fields(1) = Now()
0021 rsTableToRead.Fields(2) = Duration
0022 rsTableToRead.Update
0023Else
0024 Exit Sub
0025End If
0026MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0027Set rsTableToRead = Nothing
0028Set rsTableToRead2 = Nothing
0029End Sub

Procedures Called By This Procedure (cmdPhilosophyPapersFull_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdPhilosophyPapersFull_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPhilosophyPapersFullSubTopic_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdPhilosophyPapersFullSubTopic_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenPhilosophyPapersFullCategorisedSubTopic"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Philosophy Papers Full (Categorised by SubTopic)"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenPhilosophyPapersFullCategorisedSubTopic
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdPhilosophyPapersFullSubTopic_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdPhilosophyPapersFullSubTopic_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPhilosophyPapersFullTopic_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdPhilosophyPapersFullTopic_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenPhilosophyPapersFullCategorised"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011 strMessage = "Do you want to regenerate the ""Philosophy Papers Full (Categorised)"" page?"""
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenPhilosophyPapersFullCategorised
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdPhilosophyPapersFullTopic_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdPhilosophyPapersFullTopic_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPIAuthorAbstracts_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub cmdPIAuthorAbstracts_Click()
0002On Error Resume Next
0003 DoCmd.OpenQuery ("Philosopher's Index Search")
0004End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdPIAuthorAbstracts_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPrecis_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdPrecis_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim Duration As Double
0006Dim strRunTime As String
0007Dim RunDate As Date
0008 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenPrecisSubTopics"";")
0009RunDate = rsTableToRead.Fields(1)
0010strRunTime = Round(rsTableToRead.Fields(2), 1)
0011strMessage = "Do you want to regenerate the Web-page linking the Precis?"
0012strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0013RootCreated = ""
0014If MsgBox(strMessage, vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 WebpageGenPrecisSubTopics
0017 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0018 rsTableToRead.Edit
0019 rsTableToRead.Fields(1) = Now()
0020 rsTableToRead.Fields(2) = Duration
0021 rsTableToRead.Update
0022Else
0023 Exit Sub
0024End If
0025MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0026Set rsTableToRead = Nothing
0027End Sub

Procedures Called By This Procedure (cmdPrecis_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdPrecis_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdPrintNote_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub cmdPrintNote_Click()
0002RootCreated = ""
0003 PrintNote
0004End Sub

Procedures Called By This Procedure (cmdPrintNote_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdRecalculate_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 268
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdRecalculate_Click()
0002Dim start As Date
0003Dim Duration As Single
0004Dim rsTableToRead As Recordset
0005Dim strDoubleQuote As String
0006Dim strQuery As String
0007Dim i As Integer
0008Dim Question
0009Dim rs As Recordset
0010Dim rsRefs As Recordset
0011Dim rsTopics As Recordset
0012Dim rsSubTopics As Recordset
0013Dim rsCheck As Recordset
0014Dim strMsg As String
0015 OK = Check_Database_Size()
0016Debug.Print Now() & " - Main Database size = " & Check_Database_Size & "Mb"
0017start = Now()
0018'Reset Temp_Note_Timestamp to zero for Live Notes
0019 DoCmd.OpenQuery ("Reset_Temp_Note_Timestamp")
0020'Add PID-Related Aeon Papers
0021 Set rs = CurrentDb.OpenRecordset("Aeon_Papers_Add_Prelist")
0022If Not rs.EOF Then
0023 Set rs = Nothing
0024 Set rs = CurrentDb.OpenRecordset("Aeon_Papers_Update_Query_Year_Chk")
0025 rs.MoveFirst
0026 If rs.Fields(0) = "No" Then
0027 DoCmd.OpenQuery ("Aeon_Papers_Add_Prelist")
0028 DoCmd.OpenQuery ("Aeon_Papers_Add")
0029 DoCmd.OpenQuery ("Aeon_Papers_LastYearHours_Add")
0030 DoCmd.OpenQuery ("Aeon_Papers_LastYearHours_Total")
0031 DoCmd.OpenQuery ("Aeon_Papers_PaperID_Updt")
0032 DoCmd.OpenQuery ("PID_Note_Reading_Lists_Year_Updt")
0033 DoCmd.OpenQuery ("Aeon_Date_Fixes")
0034 DoCmd.OpenQuery ("Aeon_Timesheet_Updates")
0035 Else
0036 strMsg = "Update Aeon Queries Aeon_Papers_LastYearHours_Add, Aeon_Papers_LastYearHours_Total and then Aeon_Papers_Update_Query_Year_Chk with new previous year"
0037 Debug.Print Now() & " - " & strMsg
0038 MsgBox (strMsg)
0039 End If
0040 Set rs = Nothing
0041End If
0042 DoCmd.RunSQL ("DELETE * FROM Paper_Citings_List_New;")
0043 DoCmd.OpenQuery ("Paper_Citings_List_New_Gen")
0044 DoCmd.RunSQL ("DELETE * FROM Book_Citings_List_New;")
0045 DoCmd.OpenQuery ("Book_Citings_List_New_Gen")
0046 DoCmd.RunSQL ("DELETE * FROM Authors_Cited_By_All_List;")
0047 DoCmd.OpenQuery ("Authors_Cited_By_All_List_Gen")
0048 DoCmd.RunSQL ("DELETE * FROM Notes_Cited_By_All_List;")
0049 DoCmd.OpenQuery ("Notes_Cited_By_All_List_Gen")
0050 DoCmd.RunSQL ("DELETE * FROM BookPaperAbstracts_List;")
0051 DoCmd.OpenQuery ("BookPaperAbstracts_List_Gen")
0052'New Year Stuff
0053If (Month(Now()) = 9 And Day(Now()) > 28) Then
0054 MsgBox ("Warning - the new academic year is about to start - you need to set things up for the new year!")
0055Else
0056 If (Month(Now()) = 10 And Day(Now()) = 1) Then 'Need to set this check up to see if I've actually done this ...
0057 MsgBox ("Warning - the new academic year has started - you need to set things up for the new year!")
0058 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
0059 Change_Of_Year 'This will Stop ... perform the changes to queries, etc, first. Alternatively, just run Sub Change_Of_Year on its own.
0060 End If
0061 End If
0062End If
0063'Ask now for use later ...
0064 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0065Question = vbYes
0066i = rsTableToRead.RecordCount
0067If i > 5 Then
0068 Question = MsgBox("Regenerate " & i & " Notes?", vbYesNo)
0069End If
0070'Produce Oboe-Practice report
0071 DoCmd.OpenQuery ("Oboe_Latest_Lesson_Zap")
0072 DoCmd.OpenQuery ("Oboe_Latest_Lesson_GEN")
0073 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0074 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0075 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0076 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0077 DoCmd.OpenQuery ("Oboe_Practice_Hours_ADD")
0078 DoCmd.OpenQuery ("Oboe_Practice_Hours_Zeroise")
0079 DoCmd.OpenQuery ("Oboe_Practice_Hours_Update")
0080'Since last lesson
0081 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0082 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0083 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0084 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_2021_GEN")
0085 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_LastYear_GEN")
0086 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Last_Lesson_Prune")
0087 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0088 DoCmd.OpenQuery ("Oboe_Practice_Hours_Latest_Lesson_Update")
0089 DoCmd.OpenQuery ("Oboe_Practice_Hours_List")
0090'Check for Object titles with Double-quotes
0091strDoubleQuote = """"""
0092strDoubleQuote = "*" & strDoubleQuote & "*"
0093 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));"
0094Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0095If Not rsCheck.EOF Then
0096 Stop
0097End If
0098 strQuery = "SELECT Notes_Archive.Item_Title FROM Notes_Archive WHERE (((Notes_Archive.Item_Title) Like """ & strDoubleQuote & """));"
0099Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0100If Not rsCheck.EOF Then
0101 Stop
0102End If
0103 strQuery = "SELECT Papers.Title FROM Papers WHERE (((Papers.Title) Like """ & strDoubleQuote & """));"
0104Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0105If Not rsCheck.EOF Then
0106 Stop
0107End If
0108 strQuery = "SELECT Books.Title FROM Books WHERE (((Books.Title) Like """ & strDoubleQuote & """));"
0109Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0110If Not rsCheck.EOF Then
0111 Stop
0112End If
0113'Check for Books with Comments containing "++nnn++" style Note-links
0114 strQuery = "SELECT Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++*""));"
0115Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0116If Not rsCheck.EOF Then
0117 Stop
0118End If
0119 WebpageGenDud_Abstracts_Papers
0120 WebpageGenDud_Abstracts_Books
0121'Regenerate "Time_By_Weekday_Prelist" Table
0122 DoCmd.RunSQL ("DELETE Time_By_Weekday_Prelist.* FROM Time_By_Weekday_Prelist;")
0123 DoCmd.OpenQuery ("Time_By_Weekday_Prelist_GEN")
0124'Add any idempotent Alternates for new Notes
0125 DoCmd.OpenQuery ("Note_Alternates_Add")
0126'Encode Weblinks
0127 OK = Convert_Webrefs("Author")
0128 OK = Convert_Webrefs("Book")
0129 OK = Convert_Webrefs("Note")
0130 OK = Convert_Webrefs("Note_Archive")
0131 OK = Convert_Webrefs("Paper")
0132 Update_Note_Groups_Latest_Timestamp
0133'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
0134 Set rsSubTopics = CurrentDb.OpenRecordset("SELECT * FROM [Sub-Topics] WHERE [Sub-Topics]!ID = 0;")
0135 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));")
0136If Not rsTopics.EOF Then
0137 rsTopics.MoveFirst
0138 Do Until rsTopics.EOF
0139 Set rsRefs = CurrentDb.OpenRecordset("Sub-Topics_ID_Max")
0140 rsSubTopics.AddNew
0141 rsSubTopics.Fields(0) = rsRefs.Fields(0)
0142 rsSubTopics.Fields(1) = rsTopics.Fields(1)
0143 rsSubTopics.Fields(2) = rsTopics.Fields(0)
0144 rsSubTopics.Fields(3) = rsTopics.Fields(2)
0145 rsSubTopics.Fields(4) = rsTopics.Fields(3)
0146 rsSubTopics.Update
0147 Set rsRefs = Nothing
0148 rsTopics.MoveNext
0149 Loop
0150End If
0151Set rsTopics = Nothing
0152Set rsSubTopics = Nothing
0153 DoCmd.OpenQuery ("Books_Versus_Papers_Add")
0154 DoCmd.OpenQuery ("Paper_Book_IDs_Update")
0155 DoCmd.OpenQuery ("Paper_Book_IDs_Move_Update")
0156 DoCmd.OpenQuery ("PID_Missing_Online_Papers_Add")
0157'Delete current-year actuals prior to replacing
0158 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0159 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;")
0160 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);")
0161 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0162 DoCmd.OpenQuery ("Actual_Hours_Temp_Zap")
0163 DoCmd.OpenQuery ("Actual_Hours_Temp_GEN")
0164 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Add")
0165'Check no "orphan" actuals (current year - due to timesheet reference error, or deleted Papers)
0166 Set rsTableToRead = CurrentDb.OpenRecordset("Current_Year_Papers_Actuals_Check")
0167If Not rsTableToRead.EOF Then
0168 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Check")
0169 MsgBox ("Missing Paper(s) for Actuals Update from current year's Actuals")
0170 Stop
0171End If
0172'Update Papers total actuals (using a dummy table)
0173 DoCmd.RunSQL ("UPDATE Papers SET Papers.[Actual - Total] = 0;")
0174 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;")
0175 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));")
0176 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0177 DoCmd.OpenQuery ("Estimate - Update")
0178 DoCmd.OpenQuery ("Estimate - Update Outstanding")
0179 DoCmd.OpenQuery ("Estimate - Update Zeros From Actuals")
0180'Check no "orphan" actuals
0181 Set rsTableToRead = CurrentDb.OpenRecordset("Missing_Papers_For_Actuals")
0182If Not rsTableToRead.EOF Then
0183 DoCmd.OpenQuery ("Missing_Papers_For_Actuals")
0184 MsgBox ("Missing Paper(s) for Actuals Update")
0185 Stop
0186End If
0187 DoCmd.OpenQuery ("Notes_To_Print_Add") 'AMMENDED 20/03/22 - Set to non-current
0188 DoCmd.OpenQuery ("Notes_To_Print_Update")
0189 DoCmd.OpenQuery ("Books - Estimates")
0190'Update Books total actuals (using a dummy table)
0191 DoCmd.RunSQL ("UPDATE Books SET Books.[Actual - Total] = 0;")
0192 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));")
0193 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));")
0194 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0195 DoCmd.OpenQuery ("Estimate - Update Outstanding - Books")
0196 DoCmd.OpenQuery ("AuthorAndTitle_Update")
0197 DoCmd.OpenQuery ("Papers - Location Update")
0198 Find_Book_Paper_Links
0199 DoCmd.OpenQuery ("Paper_Books_Zap")
0200 DoCmd.OpenQuery ("Paper_Books_GEN")
0201 Regen_Book_Paper_Links
0202 Regen_Book_Book_Links
0203 Regen_Book_Note_Links
0204 Regen_Paper_Paper_Links
0205 Regen_Paper_Book_Links
0206 Regen_Paper_Note_Links
0207 Regen_Author_Book_Links
0208 Regen_Author_Paper_Links
0209 WebpageGenBooksRecent
0210 WebpageGenBooksRecentCategorised
0211 DoCmd.OpenQuery ("Authors_List_Authors_Table_Zap")
0212 DoCmd.OpenQuery ("Authors_List_Authors_Table_GEN")
0213 DoCmd.OpenQuery ("Authors_Add")
0214 Author_Display_Names_Convert
0215 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0216 DoCmd.OpenQuery ("Book_Abstracts_Changed")
0217 DoCmd.OpenQuery ("Book_Abstracts_Archive_Zap")
0218 DoCmd.OpenQuery ("Book_Abstracts_Archive_Add")
0219 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0220'Update table that shows to display Book rather than Paper
0221 DoCmd.OpenQuery ("Book_Paper_Solitons_Zap")
0222 DoCmd.OpenQuery ("Book_Paper_Solitons_GEN")
0223'... Except where the solitary Paper has a different Author or Title to the Book
0224 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Zap")
0225 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Gen")
0226 DoCmd.OpenQuery ("Book_Paper_Solitons_Prune")
0227'Regenerate the triggers for Pages impacted by changed links
0228 strQuery = "DELETE Page_Regen.* FROM Page_Regen;"
0229DoCmd.RunSQL (strQuery)
0230 DoCmd.OpenQuery ("Page_Regen_GEN")
0231 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0232i = rsTableToRead.RecordCount
0233If Question = vbYes Then 'Asked the Question at the beginning!
0234 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0235 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;")
0236 Archive_Notes_Now = "No"
0237 Regenerate_the_Links = "No"
0238 Regen_Notes_Only = "Yes"
0239 CreateNotesWebPages ("Yes")
0240 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""));"
0241 DoCmd.RunSQL (strQuery)
0242 DoCmd.RunSQL ("DELETE * FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N""));")
0243End If
0244Set rsTableToRead = Nothing
0245 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));")
0246 DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Outstanding Developments (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=981)));")
0247 DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Progress to Date (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=822)));")
0248 DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Status: Oboe Practice (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=1308)));")
0249 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0250 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1256));") 'Regenerate the "Dud Links" Note
0251 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID, [Timestamp] ) SELECT Notes.ID, Now() AS X 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
0255Archive_Notes_Now = "No"
0256Regenerate_the_Links = "No"
0257Regen_Notes_Only = "Yes"
0258 CreateNotesWebPages ("Yes")
0259 Check_Types
0260 Cross_Reference_Changes_Prune
0261Duration = Round((Now() - start) * 24 * 60, 2)
0262If Duration < 1 Then
0263 Duration = Round(Duration * 60, 0)
0264 MsgBox "Recalculation Complete in " & Duration & " seconds.", vbOKOnly, "Recalculate"
0265Else
0266 MsgBox "Recalculation Complete in " & Duration & " minutes.", vbOKOnly, "Recalculate"
0267End If
0268End Sub

Procedures Called By This Procedure (cmdRecalculate_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdRecalculate_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdSearch_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdSearch_Click()
0002 DoCmd.OpenQuery ("Papers - Search for Update")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdSearch_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdSearchAbstracts_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdSearchAbstracts_Click()
0002DoCmd.OpenQuery ("Abstracts Search - General")
0003End Sub

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdSearchBooks_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdSearchBooks_Click()
0002 DoCmd.OpenQuery ("Books Search - General")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdSearchBooks_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdSearchNotes_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdSearchNotes_Click()
0002 DoCmd.OpenQuery ("Notes_Search")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdSearchNotes_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdSpider_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 15

Line-No. / Ref.Code Line
0001Private Sub cmdSpider_Click()
0002 DoCmd.OpenQuery ("Blocked_Spider_Files")
0003 DoCmd.OpenTable ("Site_Map")
0004 DoCmd.OpenTable ("Directory_Structure")
0005 DoCmd.OpenTable ("Spider_Control")
0006If MsgBox("Do you want to run the Web Spider? Are the parameters correct? If not, reply ""No"", fix the table, and try again.", vbYesNo) = vbYes Then
0007 Stop
0008 'Check the tables - and if OK, continue ...
0009 DoCmd.Close acTable, "Spider_Control"
0010 DoCmd.Close acTable, "Directory_Structure"
0011 DoCmd.Close acTable, "Site_Map"
0012 DoCmd.Close acQuery, "Blocked_Spider_Files"
0013 Spider_Ctrl
0014End If
0015End Sub

Procedures Called By This Procedure (cmdSpider_Click) Tables / Queries / Fragments Directly Used By This Procedure (cmdSpider_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdSupervisions_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdSupervisions_Click()
0002 DoCmd.OpenQuery ("Notes_Supervisions")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdSupervisions_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: cmdUpdateAbstracts_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 3

Line-No. / Ref.Code Line
0001Private Sub cmdUpdateAbstracts_Click()
0002 DoCmd.OpenQuery ("Identity Papers - Abstracts - Read (Updateable)")
0003End Sub

Tables / Queries / Fragments Directly Used By This Procedure (cmdUpdateAbstracts_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: EndTimer
Procedure Type: Public Function
Module: StopWatch
Lines of Code: 3

Line-No. / Ref.Code Line
0001Public Function EndTimer() As Long
0002 EndTimer = (GetTickCount - mlngStart)
0003End Function

Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Query_Documenter
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 31
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Query_Documenter()
0002Dim a As String
0003Dim b As String
0004Dim rsTableToRead As Recordset
0005'This module - initially based on Code_Documenter (needs to) perform the following functions:-
0006'1. Note which Queries use which sub-Queries
0007'2. Note which Queries reference which Tables
0008'Two further tasks:-
0009'3. Note which Code Routines use which Queries
0010'4. Note which Code Routines use which Tables
0011'... are retained by Code_Documenter
0012'Ready the Query Links Tables
0013 DoCmd.RunSQL ("DELETE Query_Links_Table.*, Query_Links_Table.Object_1_Type FROM Query_Links_Table WHERE Query_Links_Table.Object_1_Type <> ""C"";")
0014 Set rsQueryLinksDB = CurrentDb.OpenRecordset("Select Query_Links_Table.* FROM Query_Links_Table;")
0015'Read the Queries
0016 Set rsTableToRead = CurrentDb.OpenRecordset("Select Query_Definitions.Query_Name, Query_Definitions.Query_SQL FROM Query_Definitions ORDER BY Query_Name;")
0017'Read Union of Query and Table Names for subsequent checking
0018 Set rsQueryDB = CurrentDb.OpenRecordset("Select Query_Definitions.Query_Name, ""Q"", Len([Query_Definitions.Query_Name]) AS Expr1 FROM Query_Definitions UNION ALL Select Table_Definitions.Table_Name, ""T"", Len([Table_Definitions.Table_Name]) AS Expr1 FROM Table_Definitions ORDER BY Expr1 DESC;")
0019rsTableToRead.MoveFirst
0020Do Until rsTableToRead.EOF
0021 'New Query
0022 a = rsTableToRead.Fields(0)
0023 b = rsTableToRead.Fields(1)
0024 'Check and Add Query_Links
0025 OK = Query_Use_Checker(a, "Q", b)
0026 rsTableToRead.MoveNext
0027Loop
0028Set rsTableToRead = Nothing
0029Set rsQueryLinksDB = Nothing
0030Set rsCodeDB = Nothing
0031End Sub

Procedures Calling This Procedure (Query_Documenter) Procedures Called By This Procedure (Query_Documenter) Tables / Queries / Fragments Directly Used By This Procedure (Query_Documenter) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


© Theo Todman, June 2007 - May 2025. 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