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: 109
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 ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=822));") 'Regenerate the "Website - Progress to Date" Note
0098 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note
0099 Archive_Notes_Now = "No"
0100 Regenerate_the_Links = "No"
0101 Regen_Notes_Only = "Yes"
0102 CreateNotesWebPages ("Yes")
0103 MsgBox ("Development Log Web Pages Output OK")
0104 Exit Sub
0105 Case Else
0106 Exit Sub
0107End Select
0108DoCmd.OpenQuery (strQuery)
0109End 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: 356
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 On Error Resume Next
0138 rsTableControl.Update
0139 If Err.Number = 3022 Then
0140 MsgBox ("Duplicate Note (" & Temp_Note_ID & ") selected")
0141 End If
0142 Err.Number = 0
0143 End If
0144 Loop
0145 'Check whether we got it right!
0146 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.Note_ID, IIf([Item_Title] & """"="""",""Invalid Note ID"",[Item_Title]) AS [Note Title] FROM Notes_To_Regen LEFT JOIN Notes ON Notes_To_Regen.Note_ID = Notes.ID ORDER BY IIf([Item_Title] & """"="""",""Invalid Note ID"",[Item_Title]);")
0147 First_Note_To_Regen = 0
0148 i = 0
0149 If Not rsTableControl.EOF Then
0150 rsTableControl.MoveFirst
0151 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0152 i = rsTableControl.RecordCount
0153 End If
0154 If i = 0 Then
0155 Regen_Blurb = ""
0156 Else
0157 If i = 1 Then
0158 Regen_Blurb = "Do you want to select this Note? The Note is " & First_Note_To_Regen & ")."
0159 Else
0160 If i > 9 Then
0161 Regen_Blurb = "The first 10 Notes (of " & i & ") are:-" & Chr$(10)
0162 Else
0163 Regen_Blurb = "The " & i & " Notes are:-" & Chr$(10)
0164 End If
0165 For j = 1 To 10
0166 If rsTableControl.EOF Then
0167 j = 11
0168 Else
0169 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0170 Regen_Blurb = Regen_Blurb & IIf(j = 1, "", ",") & Chr$(10) & "..." & rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) & ")"
0171 rsTableControl.MoveNext
0172 End If
0173 Next j
0174 Regen_Blurb = "Do you want to select these Notes? " & Regen_Blurb
0175 End If
0176 End If
0177 If i > 0 Then
0178 If MsgBox(Regen_Blurb, vbYesNo) <> vbYes Then
0179 MsgBox ("Try again then!")
0180 Exit Sub
0181 End If
0182 End If
0183 End If
0184Else
0185 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0186 If MsgBox("Do you want to regenerate ranges of Notes based on the Note_Regen_Ranges table?", vbYesNo + vbDefaultButton2) = vbYes Then
0187 Regen_Notes_Only = "Yes"
0188 Run_Type = "Ranges"
0189 Etc_Message = " ... Etc. " & Chr(10)
0190 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0191 If Not rsTableToRead.EOF Then
0192 rsTableToRead.MoveFirst
0193 NumberOfRows = rsTableToRead.RecordCount
0194 RowCount = 0
0195 StopRows = False
0196 strMessage = "Run for the following range" & IIf(rsTableToRead.RecordCount > 1, "s", "") & "?" & Chr(10) & Chr(10)
0197 Do While Not rsTableToRead.EOF
0198 RowCount = RowCount + 1
0199 If RowCount < 15 Then
0200 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10)
0201 Else
0202 If StopRows = False Then
0203 If NumberOfRows > 20 Then
0204 StopRows = True
0205 strMessage = strMessage & Etc_Message
0206 Else
0207 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10)
0208 End If
0209 End If
0210 End If
0211 Total_Run = Total_Run + rsTableToRead.Fields(5)
0212 rsTableToRead.MoveNext
0213 Loop
0214 strMessage = strMessage & "Total time = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0215 Else
0216 DoCmd.OpenTable ("Note_Regen_Ranges")
0217 MsgBox ("No Ranges selected. Update the Note_Regen_Ranges Table.")
0218 End
0219 End If
0220 Total_Run = 0
0221 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = False ORDER BY ID_Start;")
0222 If Not rsTableToRead.EOF Then
0223 NumberOfRows = NumberOfRows + rsTableToRead.RecordCount
0224 strMessage = strMessage & "Not selected:- " & Chr(10) & Chr(10)
0225 rsTableToRead.MoveFirst
0226 Do While Not rsTableToRead.EOF
0227 RowCount = RowCount + 1
0228 If StopRows = False Then
0229 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10)
0230 End If
0231 If RowCount > 18 Then
0232 If NumberOfRows > 20 Then
0233 StopRows = True
0234 strMessage = strMessage & Etc_Message
0235 Etc_Message = ""
0236 End If
0237 End If
0238 Total_Run = Total_Run + rsTableToRead.Fields(5)
0239 rsTableToRead.MoveNext
0240 Loop
0241 strMessage = strMessage & "Total time outstanding = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0242 End If
0243 Response = MsgBox(strMessage, vbYesNo)
0244 If Response = vbNo Then
0245 DoCmd.OpenTable ("Note_Regen_Ranges")
0246 MsgBox ("Update the Note_Regen_Ranges Table.")
0247 End
0248 Else
0249 RunStartTime = Now()
0250 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0251 If Not rsTableToRead.EOF Then
0252 rsTableToRead.MoveFirst
0253 StartTime = Now()
0254 Do While Not rsTableToRead.EOF
0255 'Clear Notes_To_Regen table & ready for inserts
0256 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0257 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0258 'Update the table
0259 Start_Note_ID = rsTableToRead.Fields(1)
0260 End_Note_ID = rsTableToRead.Fields(2)
0261 For Temp_Note_ID = Start_Note_ID To End_Note_ID
0262 rsTableControl.AddNew
0263 rsTableControl.Fields(0) = Temp_Note_ID
0264 rsTableControl.Update
0265 Next Temp_Note_ID
0266 automatic_processing = "Yes"
0267 CreateNotesWebPages
0268 'Update the control table
0269 Duration = Now() - StartTime
0270 Duration = Duration * 24 * 60
0271 Duration = Round(Duration, 1)
0272 RunDate = Now()
0273 rsTableToRead.Edit
0274 rsTableToRead.Fields(4) = RunDate
0275 rsTableToRead.Fields(5) = Duration
0276 rsTableToRead.Update
0277 StartTime = Now()
0278 rsTableToRead.MoveNext
0279 Loop
0280 End If
0281 End If
0282 Else
0283 If MsgBox("Do you want to regenerate a bespoke range of Notes?", vbYesNo + vbDefaultButton2) = vbYes Then
0284 Regen_Notes_Only = "Yes"
0285 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0286 Temp_Note_ID = InputBox("Enter Start Note ID")
0287 Temp_Note_ID = Val(Temp_Note_ID)
0288 If Temp_Note_ID > 0 Then
0289 Start_Note_ID = Temp_Note_ID
0290 Temp_Note_ID = InputBox("Enter End Note ID")
0291 Temp_Note_ID = Val(Temp_Note_ID)
0292 If Temp_Note_ID > 0 Then
0293 If Temp_Note_ID > Start_Note_ID Then
0294 End_Note_ID = Temp_Note_ID
0295 For Temp_Note_ID = Start_Note_ID To End_Note_ID
0296 rsTableControl.AddNew
0297 rsTableControl.Fields(0) = Temp_Note_ID
0298 rsTableControl.Update
0299 Next Temp_Note_ID
0300 End If
0301 End If
0302 End If
0303 End If
0304 End If
0305End If
0306If Run_Type = "Ranges" Then
0307 GoTo The_End
0308End If
0309'Check for individually-selected or range-selected Notes
0310 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto INNER JOIN Notes_To_Regen ON Notes_List_Auto.ID = Notes_To_Regen.Note_ID ORDER BY Notes_List_Auto.ID;"
0311Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0312If Not rsTableToRead.EOF Then
0313 Regen_Notes_Only = "Yes"
0314 If MsgBox("Regenerate the Links?", vbYesNo + vbDefaultButton2) = vbYes Then
0315 Regenerate_the_Links = "Yes"
0316 End If
0317Else
0318 Regenerate_the_Links = "Yes"
0319 Archive_Notes_Now = "Yes"
0320 'Check if only doing Temp Notes - Read Temp Notes records
0321 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Status = ""Temp"" ORDER BY Notes_List_Auto.ID;"
0322 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0323 If Not rsTableToRead.EOF Then
0324 If MsgBox("Temp Notes only?", vbYesNo + vbDefaultButton2) = vbYes Then
0325 Archive_Notes_Now = "No"
0326 Temp_Notes_Only = "Yes"
0327 GoTo Create_Notes
0328 End If
0329 End If
0330 If MsgBox("Changed Notes only?", vbYesNo) = vbYes Then
0331 Changed_Notes_Only = "Yes"
0332 If MsgBox("Include Notes Linked to Changed Notes?", vbYesNo + vbDefaultButton2) = vbYes Then
0333 Include_Associated_Notes = "Yes"
0334 End If
0335 End If
0336End If
0337Create_Notes:
0338'Final Check ..
0339Regen_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"". "
0340If MsgBox(Regen_Blurb, vbOKCancel) = vbCancel Then
0341 Exit Sub
0342Else
0343 automatic_processing = "No"
0344 CreateNotesWebPages
0345End If
0346The_End:
0347If Run_Type = "Ranges" Then
0348 Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0349 If Duration < 1 Then
0350 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0351 MsgBox "Note Ranges Regeneration Complete in " & Duration & " seconds.", vbOKOnly, "Create Notes Webpages"
0352 Else
0353 MsgBox "Note Ranges Regeneration Complete in " & Duration & " minutes.", vbOKOnly, "Create Notes Webpages"
0354 End If
0355End If
0356End 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: 43
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)
0013RootCreated = ""
0014 strMessage = "Do you want to regenerate the ""Note_Paper_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 'Note_Paper_Links - Live Notes
0018 StartTime = Now()
0019 strControlQuery = "SELECT Notes.ID, Notes.Item_Text, 0 AS x FROM Notes;"
0020 Set rsTableToRead2 = CurrentDb.OpenRecordset(strControlQuery)
0021 OK = Regen_Note_Paper_Links(rsTableToRead2, 0, 1, 2)
0022 'Note_Paper_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_Paper_Links(rsTableToRead2, 0, 1, 2)
0026 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0027 MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0028End If
0029 strMessage = "Do you want to regenerate the ""Papers To Notes Links"" pages?"""
0030strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0031If MsgBox(strMessage, vbYesNo) = vbYes Then
0032 WebpageGenPapersToNotes
0033 WebpageGenNotePapersLinks
0034 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0035 rsTableToRead.Edit
0036 rsTableToRead.Fields(1) = Now()
0037 rsTableToRead.Fields(2) = Duration
0038 rsTableToRead.Update
0039 MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0040End If
0041Set rsTableToRead = Nothing
0042Set rsTableToRead2 = Nothing
0043End 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'Add PID-Related Aeon Papers
0019 Set rs = CurrentDb.OpenRecordset("Aeon_Papers_Add_Prelist")
0020If Not rs.EOF Then
0021 Set rs = Nothing
0022 Set rs = CurrentDb.OpenRecordset("Aeon_Papers_Update_Query_Year_Chk")
0023 rs.MoveFirst
0024 If rs.Fields(0) = "No" Then
0025 DoCmd.OpenQuery ("Aeon_Papers_Add_Prelist")
0026 DoCmd.OpenQuery ("Aeon_Papers_Add")
0027 DoCmd.OpenQuery ("Aeon_Papers_LastYearHours_Add")
0028 DoCmd.OpenQuery ("Aeon_Papers_LastYearHours_Total")
0029 DoCmd.OpenQuery ("Aeon_Papers_PaperID_Updt")
0030 DoCmd.OpenQuery ("PID_Note_Reading_Lists_Year_Updt")
0031 DoCmd.OpenQuery ("Aeon_Date_Fixes")
0032 DoCmd.OpenQuery ("Aeon_Timesheet_Updates")
0033 Else
0034 strMsg = "Update Aeon Queries Aeon_Papers_LastYearHours_Add, Aeon_Papers_LastYearHours_Total and then Aeon_Papers_Update_Query_Year_Chk with new previous year"
0035 Debug.Print Now() & " - " & strMsg
0036 MsgBox (strMsg)
0037 End If
0038 Set rs = Nothing
0039End If
0040 DoCmd.RunSQL ("DELETE * FROM Paper_Citings_List_New;")
0041 DoCmd.OpenQuery ("Paper_Citings_List_New_Gen")
0042 DoCmd.RunSQL ("DELETE * FROM Book_Citings_List_New;")
0043 DoCmd.OpenQuery ("Book_Citings_List_New_Gen")
0044 DoCmd.RunSQL ("DELETE * FROM Authors_Cited_By_All_List;")
0045 DoCmd.OpenQuery ("Authors_Cited_By_All_List_Gen")
0046 DoCmd.RunSQL ("DELETE * FROM Notes_Cited_By_All_List;")
0047 DoCmd.OpenQuery ("Notes_Cited_By_All_List_Gen")
0048 DoCmd.RunSQL ("DELETE * FROM BookPaperAbstracts_List;")
0049 DoCmd.OpenQuery ("BookPaperAbstracts_List_Gen")
0050'New Year Stuff
0051If (Month(Now()) = 9 And Day(Now()) > 28) Then
0052 MsgBox ("Warning - the new academic year is about to start - you need to set things up for the new year!")
0053Else
0054 If (Month(Now()) = 10 And Day(Now()) = 1) Then 'Need to set this check up to see if I've actually done this ...
0055 MsgBox ("Warning - the new academic year has started - you need to set things up for the new year!")
0056 If MsgBox("Would you like to run the New_Year_Crosstab_Prime update? The queries & various tables have to be updated first!", vbYesNo) = vbYes Then
0057 Change_Of_Year 'This will Stop ... perform the changes to queries, etc, first. Alternatively, just run Sub Change_Of_Year on its own.
0058 End If
0059 End If
0060End If
0061'Ask now for use later ...
0062 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0063Question = vbYes
0064i = rsTableToRead.RecordCount
0065If i > 5 Then
0066 Question = MsgBox("Regenerate " & i & " Notes?", vbYesNo)
0067End If
0068'Produce Oboe-Practice report
0069 DoCmd.OpenQuery ("Oboe_Latest_Lesson_Zap")
0070 DoCmd.OpenQuery ("Oboe_Latest_Lesson_GEN")
0071 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0072 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0073 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0074 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0075 DoCmd.OpenQuery ("Oboe_Practice_Hours_ADD")
0076 DoCmd.OpenQuery ("Oboe_Practice_Hours_Zeroise")
0077 DoCmd.OpenQuery ("Oboe_Practice_Hours_Update")
0078'Since last lesson
0079 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0080 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0081 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0082 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_2021_GEN")
0083 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_LastYear_GEN")
0084 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Last_Lesson_Prune")
0085 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0086 DoCmd.OpenQuery ("Oboe_Practice_Hours_Latest_Lesson_Update")
0087 DoCmd.OpenQuery ("Oboe_Practice_Hours_List")
0088'Check for Object titles with Double-quotes
0089strDoubleQuote = """"""
0090strDoubleQuote = "*" & strDoubleQuote & "*"
0091 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));"
0092Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0093If Not rsCheck.EOF Then
0094 Stop
0095End If
0096 strQuery = "SELECT Notes_Archive.Item_Title FROM Notes_Archive WHERE (((Notes_Archive.Item_Title) Like """ & strDoubleQuote & """));"
0097Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0098If Not rsCheck.EOF Then
0099 Stop
0100End If
0101 strQuery = "SELECT Papers.Title FROM Papers WHERE (((Papers.Title) Like """ & strDoubleQuote & """));"
0102Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0103If Not rsCheck.EOF Then
0104 Stop
0105End If
0106 strQuery = "SELECT Books.Title FROM Books WHERE (((Books.Title) Like """ & strDoubleQuote & """));"
0107Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0108If Not rsCheck.EOF Then
0109 Stop
0110End If
0111'Check for Books with Comments containing "++nnn++" style Note-links
0112 strQuery = "SELECT Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++*""));"
0113Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0114If Not rsCheck.EOF Then
0115 Stop
0116End If
0117 WebpageGenDud_Abstracts_Papers
0118 WebpageGenDud_Abstracts_Books
0119'Regenerate "Time_By_Weekday_Prelist" Table
0120 DoCmd.RunSQL ("DELETE Time_By_Weekday_Prelist.* FROM Time_By_Weekday_Prelist;")
0121 DoCmd.OpenQuery ("Time_By_Weekday_Prelist_GEN")
0122'Add any idempotent Alternates for new Notes
0123 DoCmd.OpenQuery ("Note_Alternates_Add")
0124'Encode Weblinks
0125 OK = Convert_Webrefs("Author")
0126 OK = Convert_Webrefs("Book")
0127 OK = Convert_Webrefs("Note")
0128 OK = Convert_Webrefs("Note_Archive")
0129 OK = Convert_Webrefs("Paper")
0130 Update_Note_Groups_Latest_Timestamp
0131'Fix the IDs before continuing ... need to add code using above query as a list, and using Sub-Topics_ID_Max (re-run) for the next ID
0132 Set rsSubTopics = CurrentDb.OpenRecordset("SELECT * FROM [Sub-Topics] WHERE [Sub-Topics]!ID = 0;")
0133 Set rsTopics = CurrentDb.OpenRecordset("SELECT Topics.ID, Topics.Topic, Topics.Rationale, Topics.File_Type FROM Topics LEFT JOIN [Sub-Topics] ON Topics.Topic = [Sub-Topics].[Sub-Topic] WHERE ((([Sub-Topics].ID) Is Null));")
0134If Not rsTopics.EOF Then
0135 rsTopics.MoveFirst
0136 Do Until rsTopics.EOF
0137 Set rsRefs = CurrentDb.OpenRecordset("Sub-Topics_ID_Max")
0138 rsSubTopics.AddNew
0139 rsSubTopics.Fields(0) = rsRefs.Fields(0)
0140 rsSubTopics.Fields(1) = rsTopics.Fields(1)
0141 rsSubTopics.Fields(2) = rsTopics.Fields(0)
0142 rsSubTopics.Fields(3) = rsTopics.Fields(2)
0143 rsSubTopics.Fields(4) = rsTopics.Fields(3)
0144 rsSubTopics.Update
0145 Set rsRefs = Nothing
0146 rsTopics.MoveNext
0147 Loop
0148End If
0149Set rsTopics = Nothing
0150Set rsSubTopics = Nothing
0151 DoCmd.OpenQuery ("Books_Versus_Papers_Add")
0152 DoCmd.OpenQuery ("Paper_Book_IDs_Update")
0153 DoCmd.OpenQuery ("Paper_Book_IDs_Move_Update")
0154 DoCmd.OpenQuery ("PID_Missing_Online_Papers_Add")
0155'Delete current-year actuals prior to replacing
0156 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0157 DoCmd.RunSQL ("INSERT INTO Paper_Actuals_Zapper ( ID, [Year] ) SELECT Paper_Actuals.ID, Paper_Actuals.Year FROM Next_Reporting_Month INNER JOIN Paper_Actuals ON Next_Reporting_Month.[Reporting Year] = Paper_Actuals.Year;")
0158 DoCmd.RunSQL ("DELETE Paper_Actuals.* FROM Paper_Actuals_Zapper INNER JOIN Paper_Actuals ON (Paper_Actuals_Zapper.Year = Paper_Actuals.Year) AND (Paper_Actuals_Zapper.ID = Paper_Actuals.ID);")
0159 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0160 DoCmd.OpenQuery ("Actual_Hours_Temp_Zap")
0161 DoCmd.OpenQuery ("Actual_Hours_Temp_GEN")
0162 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Add")
0163'Check no "orphan" actuals (current year - due to timesheet reference error, or deleted Papers)
0164 Set rsTableToRead = CurrentDb.OpenRecordset("Current_Year_Papers_Actuals_Check")
0165If Not rsTableToRead.EOF Then
0166 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Check")
0167 MsgBox ("Missing Paper(s) for Actuals Update from current year's Actuals")
0168 Stop
0169End If
0170'Update Papers total actuals (using a dummy table)
0171 DoCmd.RunSQL ("UPDATE Papers SET Papers.[Actual - Total] = 0;")
0172 DoCmd.RunSQL ("INSERT INTO Paper_Actuals_Zapper ( ID, [Year], Hours ) SELECT Paper_Actuals.ID, 9999 AS Expr1, Sum(Paper_Actuals.Hours) AS SumOfHours FROM Paper_Actuals GROUP BY Paper_Actuals.ID, 9999;")
0173 DoCmd.RunSQL ("UPDATE Paper_Actuals_Zapper INNER JOIN Papers ON Paper_Actuals_Zapper.ID = Papers.ID SET Papers.[Actual - Total] = [Hours] WHERE (((Paper_Actuals_Zapper.Year)=9999));")
0174 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0175 DoCmd.OpenQuery ("Estimate - Update")
0176 DoCmd.OpenQuery ("Estimate - Update Outstanding")
0177 DoCmd.OpenQuery ("Estimate - Update Zeros From Actuals")
0178'Check no "orphan" actuals
0179 Set rsTableToRead = CurrentDb.OpenRecordset("Missing_Papers_For_Actuals")
0180If Not rsTableToRead.EOF Then
0181 DoCmd.OpenQuery ("Missing_Papers_For_Actuals")
0182 MsgBox ("Missing Paper(s) for Actuals Update")
0183 Stop
0184End If
0185 DoCmd.OpenQuery ("Notes_To_Print_Add") 'AMMENDED 20/03/22 - Set to non-current
0186 DoCmd.OpenQuery ("Notes_To_Print_Update")
0187 DoCmd.OpenQuery ("Books - Estimates")
0188'Update Books total actuals (using a dummy table)
0189 DoCmd.RunSQL ("UPDATE Books SET Books.[Actual - Total] = 0;")
0190 DoCmd.RunSQL ("INSERT INTO Paper_Actuals_Zapper ( ID, [Year], Hours ) SELECT Books.ID1, 9999 AS Expr1, Sum(Papers.[Actual - Total]) AS [SumOfActual - Total] FROM (Books INNER JOIN qryBooks ON Books.ID1 = qryBooks.ID1) INNER JOIN Papers ON qryBooks.IDs = Papers.Book GROUP BY Books.ID1, 9999 HAVING (((Sum(Papers.[Actual - Total]))>0));")
0191 DoCmd.RunSQL ("UPDATE Paper_Actuals_Zapper INNER JOIN Books ON Paper_Actuals_Zapper.ID = Books.ID1 SET Books.[Actual - Total] = [Hours] WHERE (((Paper_Actuals_Zapper.Year)=9999));")
0192 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0193 DoCmd.OpenQuery ("Estimate - Update Outstanding - Books")
0194 DoCmd.OpenQuery ("AuthorAndTitle_Update")
0195 DoCmd.OpenQuery ("Papers - Location Update")
0196 Find_Book_Paper_Links
0197 DoCmd.OpenQuery ("Paper_Books_Zap")
0198 DoCmd.OpenQuery ("Paper_Books_GEN")
0199 Regen_Book_Paper_Links
0200 Regen_Book_Book_Links
0201 Regen_Book_Note_Links
0202 Regen_Paper_Paper_Links
0203 Regen_Paper_Book_Links
0204 Regen_Paper_Note_Links
0205 Regen_Author_Book_Links
0206 Regen_Author_Paper_Links
0207 WebpageGenBooksRecent
0208 WebpageGenBooksRecentCategorised
0209 DoCmd.OpenQuery ("Authors_List_Authors_Table_Zap")
0210 DoCmd.OpenQuery ("Authors_List_Authors_Table_GEN")
0211 DoCmd.OpenQuery ("Authors_Add")
0212 Author_Display_Names_Convert
0213 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0214 DoCmd.OpenQuery ("Book_Abstracts_Changed")
0215 DoCmd.OpenQuery ("Book_Abstracts_Archive_Zap")
0216 DoCmd.OpenQuery ("Book_Abstracts_Archive_Add")
0217 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0218'Update table that shows to display Book rather than Paper
0219 DoCmd.OpenQuery ("Book_Paper_Solitons_Zap")
0220 DoCmd.OpenQuery ("Book_Paper_Solitons_GEN")
0221'... Except where the solitary Paper has a different Author or Title to the Book
0222 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Zap")
0223 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Gen")
0224 DoCmd.OpenQuery ("Book_Paper_Solitons_Prune")
0225'Regenerate the triggers for Pages impacted by changed links
0226 strQuery = "DELETE Page_Regen.* FROM Page_Regen;"
0227DoCmd.RunSQL (strQuery)
0228 DoCmd.OpenQuery ("Page_Regen_GEN")
0229 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0230i = rsTableToRead.RecordCount
0231If Question = vbYes Then 'Asked the Question at the beginning!
0232 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0233 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0234 Archive_Notes_Now = "No"
0235 Regenerate_the_Links = "No"
0236 Regen_Notes_Only = "Yes"
0237 CreateNotesWebPages ("Yes")
0238 strQuery = "DELETE Cross_Reference_Changes.*, Page_Regen.Called_Type FROM Page_Regen INNER JOIN Cross_Reference_Changes ON (Page_Regen.Calling_Type = Cross_Reference_Changes.Calling_Type) AND (Page_Regen.Called_ID = Cross_Reference_Changes.Called_ID) AND (Page_Regen.Called_Type = Cross_Reference_Changes.Called_Type) WHERE (((Page_Regen.Called_Type)=""N""));"
0239 DoCmd.RunSQL (strQuery)
0240 DoCmd.RunSQL ("DELETE * FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N""));")
0241End If
0242Set rsTableToRead = Nothing
0243 DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE (((Notes.ID)=1256)) OR (((Notes.ID)=822)) OR (((Notes.ID)=981)) OR (((Notes.ID)=1308)) OR (((Notes.ID)=1313)) OR (((Notes.ID)=1317)) OR (((Notes.ID)=1319));")
0244 DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Outstanding Developments (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=981)));")
0245 DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Website - Progress to Date (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=822)));")
0246 DoCmd.RunSQL ("UPDATE Notes SET Notes.Item_Title = ""Status: Oboe Practice (" & Year(Now) & " - " & MonthName(Month(Now())) & ")"" WHERE ((((Notes.ID)=1308)));")
0247 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0248 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1256));") 'Regenerate the "Dud Links" Note
0249 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=822));") 'Regenerate the "Website - Progress to Date" Note
0250 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note
0251 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1308));") 'Regenerate the "Status: Oboe Practice" Note
0252 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1313));") 'Regenerate the "Brief Thoughts on Language & Languages" Note
0253 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1317));") 'Regenerate the "PID Note Usage" Note
0254 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1319));") 'Regenerate the "PDFs Available on Local Website" Note
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 - Sept 2023. 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