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: 35
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. Back-up the ""Web_Generator_Performance"" database"
0007Option_Help = Option_Help & Chr$(10) & "3. De-duplicate the backup disk"
0008 Option_Help = Option_Help & Chr$(10) & "4. Search the ""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 Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance")
0026 MsgBox ("""Web_Generator_Performance"" database backed up successfully in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0027 Case 3
0028 Backup_Prune_Ctrl
0029 MsgBox ("Backup Disk de-duplicated successfully in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0030 Case 4
0031 DoCmd.OpenQuery ("Backup_Site_Map_Search")
0032 Case Else
0033 End
0034End Select
0035End 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: 39
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)
0013 strMessage = "Do you want to regenerate the ""Books To Notes Links"" pages (after first regenerating the Note-Book Links Table)?"""
0014strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0015RootCreated = ""
0016If MsgBox(strMessage, vbYesNo) = vbYes Then
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)
0026 WebpageGenBooksToNotes
0027 WebpageGenNoteBooksLinks
0028 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0029 rsTableToRead.Edit
0030 rsTableToRead.Fields(1) = Now()
0031 rsTableToRead.Fields(2) = Duration
0032 rsTableToRead.Update
0033Else
0034 Exit Sub
0035End If
0036MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0037Set rsTableToRead = Nothing
0038Set rsTableToRead2 = Nothing
0039End 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: 106
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 ("DELETE * FROM Notes_To_Regen;")
0094 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
0095 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note
0096 Archive_Notes_Now = "No"
0097 Regenerate_the_Links = "No"
0098 Regen_Notes_Only = "Yes"
0099 CreateNotesWebPages ("Yes")
0100 MsgBox ("Development Log Web Pages Output OK")
0101 Exit Sub
0102 Case Else
0103 Exit Sub
0104End Select
0105DoCmd.OpenQuery (strQuery)
0106End 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: 88
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
0009If MsgBox("Have you set the Reporting Month?", vbYesNo) = vbYes Then
0010 If MsgBox("Output the Annual Report?", vbYesNo) = vbYes Then
0011 Annual = True
0012 Else
0013 Annual = False
0014 End If
0015 If MsgBox("Output the Quarterly Report?", vbYesNo) = vbYes Then
0016 Quarterly = True
0017 Else
0018 Quarterly = False
0019 End If
0020 If MsgBox("Output the Priority Task List Report?", vbYesNo) = vbYes Then
0021 Priority = True
0022 Else
0023 Priority = False
0024 End If
0025 automatic_processing = "Yes"
0026 Start_Time = Now()
0027 'Annual Report
0028 If Annual = True Then
0029 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Zap")
0030 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Gen")
0031 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Nulls_Reset")
0032 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Read_UPD")
0033 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Write_UPD")
0034 DoCmd.OpenQuery ("Time_This_Month_List_Zap")
0035 DoCmd.OpenQuery ("Time_This_Month_List_YTD_Gen")
0036 DoCmd.OpenQuery ("Time_This_Month_List_Paper_UPD")
0037 DoCmd.OpenQuery ("Time_This_Month_List_Book_UPD")
0038 Monthly_Report_Note975_Update ("Yes")
0039 End If
0040 'Quarterly Report
0041 If Quarterly = True Then
0042 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Zap")
0043 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Gen")
0044 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Nulls_Reset")
0045 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Read_UPD")
0046 DoCmd.OpenQuery ("Time_This_Month_List_Temp_Write_UPD")
0047 DoCmd.OpenQuery ("Time_This_Month_List_Zap")
0048 DoCmd.OpenQuery ("Time_This_Month_List_Gen")
0049 DoCmd.OpenQuery ("Time_This_Month_List_Paper_UPD")
0050 DoCmd.OpenQuery ("Time_This_Month_List_Book_UPD")
0051 Monthly_Report_Note975_Update ("No")
0052 End If
0053 If Priority = True Then
0054 'Output the note
0055 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0056 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0057 rsTableControl.AddNew
0058 rsTableControl.Fields(0) = 1275
0059 rsTableControl.Update
0060 Archive_Notes_Now = "No"
0061 Regenerate_the_Links = "Yes"
0062 Regen_Notes_Only = "Yes"
0063 CreateNotesWebPages
0064 Set rsTableControl = Nothing
0065 End If
0066Else
0067 DoCmd.OpenTable ("Next_Reporting_Month")
0068 If MsgBox("Have you just changed the copyright month and want to run the update?", vbYesNo) = vbYes Then
0069 DoCmd.OpenQuery ("WebPage_DateChange")
0070 End If
0071End If
0072If Quarterly = True Or Annual = True Or Priority = True Then
0073 strMsg = ""
0074 If Annual = True Then
0075 strMsg = "YTD Summary Task List (Note 1266); "
0076 End If
0077 If Quarterly = True Then
0078 strMsg = strMsg & "This Quarter's Summary Task List (Note 975); "
0079 End If
0080 If Priority = True Then
0081 strMsg = strMsg & "Priority Task List (Note 1275) "
0082 End If
0083 If Right(strMsg, 2) = "; " Then
0084 strMsg = Left(strMsg, Len(strMsg) - 2) & " "
0085 End If
0086 MsgBox (strMsg & "output OK in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0087End If
0088End 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 Notes_To_Regen.Note_ID;")
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 Notes_To_Regen.Note_ID;")
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: 39
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)
0013 strMessage = "Do you want to regenerate the ""Papers To Notes Links"" pages (after first regenerating the Note-Paper Links Table)?"""
0014strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0015RootCreated = ""
0016If MsgBox(strMessage, vbYesNo) = vbYes Then
0017 StartTime = Now()
0018 'Note_Paper_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_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 WebpageGenPapersToNotes
0027 WebpageGenNotePapersLinks
0028 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0029 rsTableToRead.Edit
0030 rsTableToRead.Fields(1) = Now()
0031 rsTableToRead.Fields(2) = Duration
0032 rsTableToRead.Update
0033Else
0034 Exit Sub
0035End If
0036MsgBox strOutputFile & " Table Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Papers Web Table"
0037Set rsTableToRead = Nothing
0038Set rsTableToRead2 = Nothing
0039End 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: 277
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 'Update the Project_Plans table for the coming year (only)
0058 'Output the end-September Quarterly Summary & Task-List Reports - the last for the "Old Year". XChk & re-run without "Temp" when happy.
0059 'Copy StudyPlan.xlsx to StudyPlan_Old.xlsx
0060 'Update the Reporting_Months and Next_Reporting_Month tables
0061 'Update the Year_Crosstab_List_Prime table
0062 'Update and run the queries below ...
0063 DoCmd.OpenQuery ("Year_Crosstab_Old_Zap") 'Just needs running
0064 DoCmd.OpenQuery ("Year_Crosstab_Old_GEN") 'Just needs running
0065 DoCmd.OpenQuery ("New_Year_Crosstab_Prime_Zap") 'Update the query first!
0066 DoCmd.OpenQuery ("New_Year_Crosstab_Prime_OldYear_ADD") 'Update the query first!
0067 DoCmd.OpenQuery ("New_Year_Crosstab_Prime_NewYear_ADD") 'Just needs running
0068 DoCmd.OpenQuery ("Project_Plans_NextYear_Add") 'Just needs running. This is for the year after next - it just copies the coming year's plans
0069 'Set up StudyPlan.xlsx for the new year
0070 'Also update the Oboe-Practice report queries (Oboe_Practice_Hours_ADD, Oboe_Practice_Hours_Zeroise, Oboe_Practice_Hours_Update and Oboe_Practice_Hours_List)
0071 Stop
0072 End If
0073 End If
0074End If
0075'Ask now for use later ...
0076 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0077Question = ""
0078i = rsTableToRead.RecordCount
0079If i > 5 Then
0080 Question = MsgBox("Regenerate " & i & " Notes?", vbYesNo)
0081End If
0082'Produce Oboe-Practice report
0083 DoCmd.OpenQuery ("Oboe_Latest_Lesson_Zap")
0084 DoCmd.OpenQuery ("Oboe_Latest_Lesson_GEN")
0085 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0086 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0087 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0088 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0089 DoCmd.OpenQuery ("Oboe_Practice_Hours_ADD")
0090 DoCmd.OpenQuery ("Oboe_Practice_Hours_Zeroise")
0091 DoCmd.OpenQuery ("Oboe_Practice_Hours_Update")
0092'Since last lesson
0093 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0094 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0095 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0096 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_LastYear_GEN") 'Needed until there's an Oboe lesson this (academic) year - ie. prior to 30/09/21
0097 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Last_Lesson_Prune")
0098 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0099 DoCmd.OpenQuery ("Oboe_Practice_Hours_Latest_Lesson_Update")
0100 DoCmd.OpenQuery ("Oboe_Practice_Hours_List")
0101'Check for Object titles with Double-quotes
0102strDoubleQuote = """"""
0103strDoubleQuote = "*" & strDoubleQuote & "*"
0104 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));"
0105Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0106If Not rsCheck.EOF Then
0107 Stop
0108End If
0109 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));"
0110Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0111If Not rsCheck.EOF Then
0112 Stop
0113End If
0114 strQuery = "SELECT Papers.Title FROM Papers WHERE (((Papers.Title) Like """ & strDoubleQuote & """));"
0115Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0116If Not rsCheck.EOF Then
0117 Stop
0118End If
0119 strQuery = "SELECT Books.Title FROM Books WHERE (((Books.Title) Like """ & strDoubleQuote & """));"
0120Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0121If Not rsCheck.EOF Then
0122 Stop
0123End If
0124'Check for Books with Comments containing "++nnn++" style Note-links
0125 strQuery = "SELECT Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++*""));"
0126Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0127If Not rsCheck.EOF Then
0128 Stop
0129End If
0130 WebpageGenDud_Abstracts_Papers
0131 WebpageGenDud_Abstracts_Books
0132'Regenerate "Time_By_Weekday_Prelist" Table
0133 DoCmd.RunSQL ("DELETE Time_By_Weekday_Prelist.* FROM Time_By_Weekday_Prelist;")
0134 DoCmd.OpenQuery ("Time_By_Weekday_Prelist_GEN")
0135'Add any idempotent Alternates for new Notes
0136 DoCmd.OpenQuery ("Note_Alternates_Add")
0137'Encode Weblinks
0138 OK = Convert_Webrefs("Author")
0139 OK = Convert_Webrefs("Book")
0140 OK = Convert_Webrefs("Note")
0141 OK = Convert_Webrefs("Note_Archive")
0142 OK = Convert_Webrefs("Paper")
0143 Update_Note_Groups_Latest_Timestamp
0144'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
0145 Set rsSubTopics = CurrentDb.OpenRecordset("SELECT * FROM [Sub-Topics] WHERE [Sub-Topics]!ID = 0;")
0146 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));")
0147If Not rsTopics.EOF Then
0148 rsTopics.MoveFirst
0149 Do Until rsTopics.EOF
0150 Set rsRefs = CurrentDb.OpenRecordset("Sub-Topics_ID_Max")
0151 rsSubTopics.AddNew
0152 rsSubTopics.Fields(0) = rsRefs.Fields(0)
0153 rsSubTopics.Fields(1) = rsTopics.Fields(1)
0154 rsSubTopics.Fields(2) = rsTopics.Fields(0)
0155 rsSubTopics.Fields(3) = rsTopics.Fields(2)
0156 rsSubTopics.Fields(4) = rsTopics.Fields(3)
0157 rsSubTopics.Update
0158 Set rsRefs = Nothing
0159 rsTopics.MoveNext
0160 Loop
0161End If
0162Set rsTopics = Nothing
0163Set rsSubTopics = Nothing
0164 DoCmd.OpenQuery ("Books_Versus_Papers_Add")
0165 DoCmd.OpenQuery ("Paper_Book_IDs_Update")
0166 DoCmd.OpenQuery ("Paper_Book_IDs_Move_Update")
0167'Delete current-year actuals prior to replacing
0168 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0169 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;")
0170 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);")
0171 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0172 DoCmd.OpenQuery ("Actual_Hours_Temp_Zap")
0173 DoCmd.OpenQuery ("Actual_Hours_Temp_GEN")
0174 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Add")
0175'Check no "orphan" actuals (current year - due to timesheet reference error, or deleted Papers)
0176 Set rsTableToRead = CurrentDb.OpenRecordset("Current_Year_Papers_Actuals_Check")
0177If Not rsTableToRead.EOF Then
0178 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Check")
0179 MsgBox ("Missing Paper(s) for Actuals Update from current year's Actuals")
0180 Stop
0181End If
0182'Update Papers total actuals (using a dummy table)
0183 DoCmd.RunSQL ("UPDATE Papers SET Papers.[Actual - Total] = 0;")
0184 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;")
0185 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));")
0186 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0187 DoCmd.OpenQuery ("Estimate - Update")
0188 DoCmd.OpenQuery ("Estimate - Update Outstanding")
0189 DoCmd.OpenQuery ("Estimate - Update Zeros From Actuals")
0190'Check no "orphan" actuals
0191 Set rsTableToRead = CurrentDb.OpenRecordset("Missing_Papers_For_Actuals")
0192If Not rsTableToRead.EOF Then
0193 DoCmd.OpenQuery ("Missing_Papers_For_Actuals")
0194 MsgBox ("Missing Paper(s) for Actuals Update")
0195 Stop
0196End If
0197 DoCmd.OpenQuery ("Notes_To_Print_Add")
0198 DoCmd.OpenQuery ("Notes_To_Print_Update")
0199 DoCmd.OpenQuery ("Books - Estimates")
0200'Update Books total actuals (using a dummy table)
0201 DoCmd.RunSQL ("UPDATE Books SET Books.[Actual - Total] = 0;")
0202 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));")
0203 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));")
0204 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0205 DoCmd.OpenQuery ("Estimate - Update Outstanding - Books")
0206 DoCmd.OpenQuery ("Author+Title_Update")
0207 DoCmd.OpenQuery ("Papers - Location Update")
0208 Find_Book_Paper_Links
0209 DoCmd.OpenQuery ("Paper_Books_Zap")
0210 DoCmd.OpenQuery ("Paper_Books_GEN")
0211 Regen_Book_Paper_Links
0212 Regen_Book_Book_Links
0213 Regen_Book_Note_Links
0214 Regen_Paper_Paper_Links
0215 Regen_Paper_Book_Links
0216 Regen_Paper_Note_Links
0217 Regen_Author_Book_Links
0218 Regen_Author_Paper_Links
0219 WebpageGenBooksRecent
0220 WebpageGenBooksRecentCategorised
0221 DoCmd.OpenQuery ("Authors_List_Authors_Table_Zap")
0222 DoCmd.OpenQuery ("Authors_List_Authors_Table_GEN")
0223 DoCmd.OpenQuery ("Authors_Add")
0224 Author_Display_Names_Convert
0225 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0226 DoCmd.OpenQuery ("Book_Abstracts_Changed")
0227 DoCmd.OpenQuery ("Book_Abstracts_Archive_Zap")
0228 DoCmd.OpenQuery ("Book_Abstracts_Archive_Add")
0229 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0230'Update table that shows to display Book rather than Paper
0231 DoCmd.OpenQuery ("Book_Paper_Solitons_Zap")
0232 DoCmd.OpenQuery ("Book_Paper_Solitons_GEN")
0233'... Except where the solitary Paper has a different Author or Title to the Book
0234 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Zap")
0235 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Gen")
0236 DoCmd.OpenQuery ("Book_Paper_Solitons_Prune")
0237'Regenerate the triggers for Pages impacted by changed links
0238 strQuery = "DELETE Page_Regen.* FROM Page_Regen;"
0239DoCmd.RunSQL (strQuery)
0240 DoCmd.OpenQuery ("Page_Regen_GEN")
0241 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0242i = rsTableToRead.RecordCount
0243If Question = vbYes Or (i > 0 And i < 5) Then 'Asked the Question at the beginning!
0244 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0245 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;")
0246 Archive_Notes_Now = "No"
0247 Regenerate_the_Links = "No"
0248 Regen_Notes_Only = "Yes"
0249 CreateNotesWebPages ("Yes")
0250 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""));"
0251 DoCmd.RunSQL (strQuery)
0252 DoCmd.RunSQL ("DELETE * FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N""));")
0253End If
0254Set rsTableToRead = Nothing
0255 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));")
0256 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0257 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1256));") 'Regenerate the "Dud Links" Note
0258 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
0259 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note
0260 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1308));") 'Regenerate the "Status: Oboe Practice" Note
0261 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
0262 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1317));") 'Regenerate the "PID Note Usage" Note
0263 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
0264Archive_Notes_Now = "No"
0265Regenerate_the_Links = "No"
0266Regen_Notes_Only = "Yes"
0267 CreateNotesWebPages ("Yes")
0268 Check_Types
0269 Cross_Reference_Changes_Prune
0270Duration = Round((Now() - start) * 24 * 60, 2)
0271If Duration < 1 Then
0272 Duration = Round(Duration * 60, 0)
0273 MsgBox "Recalculation Complete in " & Duration & " seconds.", vbOKOnly, "Recalculate"
0274Else
0275 MsgBox "Recalculation Complete in " & Duration & " minutes.", vbOKOnly, "Recalculate"
0276End If
0277End 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 - June 2021. 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