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 withing 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: 304
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdNotes_Click()
0002Dim rsTableControl As Recordset
0003Dim rsTableToRead As Recordset
0004Dim First_Note_To_Regen As String
0005Dim Regen_Blurb As String
0006Dim i As Integer
0007Dim j As Integer
0008Dim Temp_Note_ID
0009Dim Start_Note_ID As Integer
0010Dim End_Note_ID As Integer
0011Dim strControlQuery As String
0012Dim strMessage As String
0013Dim StartTime As Date
0014Dim RunStartTime As Date
0015Dim Duration As Double
0016Dim Response As String
0017Dim Total_Run As Single
0018Dim Run_Type As String
0019Dim RunDate As Date
0020Dim NumberOfRows As Integer
0021Dim RowCount As Integer
0022Dim StopRows As Boolean
0023Dim Etc_Message As String
0024RootCreated = ""
0025If MsgBox("Do you want to regenerate the Notes Web-pages?", vbYesNo) <> vbYes Then
0026 Exit Sub
0027End If
0028Run_Type = ""
0029Temp_Notes_Only = "No"
0030Changed_Notes_Only = "No"
0031Include_Associated_Notes = "No"
0032Regen_Notes_Only = "No"
0033Regenerate_the_Links = "No"
0034Archive_Notes_Now = "No"
0035'Check how many notes regenerated last time - and show the first
0036 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;")
0037First_Note_To_Regen = 0
0038i = 0
0039If Not rsTableControl.EOF Then
0040 rsTableControl.MoveFirst
0041 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0042 i = rsTableControl.RecordCount
0043End If
0044If i = 0 Then
0045 Regen_Blurb = ""
0046Else
0047 If i = 1 Then
0048 Regen_Blurb = "Do you want to select the same Note as last time? The Note is " & First_Note_To_Regen & ")."
0049 Else
0050 If i > 9 Then
0051 Regen_Blurb = "The first 10 Notes (of " & i & ") are:-" & Chr$(10)
0052 Else
0053 Regen_Blurb = "The " & i & " Notes are:-" & Chr$(10)
0054 End If
0055 For j = 1 To 10
0056 If rsTableControl.EOF Then
0057 j = 11
0058 Else
0059 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0060 Regen_Blurb = Regen_Blurb & IIf(j = 1, "", ",") & Chr$(10) & "..." & rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) & ")"
0061 rsTableControl.MoveNext
0062 End If
0063 Next j
0064 Regen_Blurb = "Do you want to select the same Notes as last time? " & Regen_Blurb
0065 End If
0066End If
0067If MsgBox("Do you want to select individual Notes?", vbYesNo + vbDefaultButton1) = vbYes Then
0068 If Regen_Blurb = "" Then
0069 Else
0070 If MsgBox(Regen_Blurb, vbYesNo) <> vbYes Then
0071 Regen_Blurb = ""
0072 End If
0073 End If
0074 If Regen_Blurb = "" Then
0075 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0076 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0077 Temp_Note_ID = 1
0078 Do While Temp_Note_ID <> 0
0079 Temp_Note_ID = 0
0080 Temp_Note_ID = InputBox("Enter a Note ID")
0081 Temp_Note_ID = Val(Temp_Note_ID)
0082 If Temp_Note_ID <> 0 Then
0083 rsTableControl.AddNew
0084 rsTableControl.Fields(0) = Temp_Note_ID
0085 On Error Resume Next
0086 rsTableControl.Update
0087 If Err.Number = 3022 Then
0088 MsgBox ("Duplicate Note (" & Temp_Note_ID & ") selected")
0089 End If
0090 Err.Number = 0
0091 End If
0092 Loop
0093 'Check whether we got it right!
0094 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;")
0095 First_Note_To_Regen = 0
0096 i = 0
0097 If Not rsTableControl.EOF Then
0098 rsTableControl.MoveFirst
0099 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0100 i = rsTableControl.RecordCount
0101 End If
0102 If i = 0 Then
0103 Regen_Blurb = ""
0104 Else
0105 If i = 1 Then
0106 Regen_Blurb = "Do you want to select this Note? The Note is " & First_Note_To_Regen & ")."
0107 Else
0108 If i > 9 Then
0109 Regen_Blurb = "The first 10 Notes (of " & i & ") are:-" & Chr$(10)
0110 Else
0111 Regen_Blurb = "The " & i & " Notes are:-" & Chr$(10)
0112 End If
0113 For j = 1 To 10
0114 If rsTableControl.EOF Then
0115 j = 11
0116 Else
0117 First_Note_To_Regen = rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1)
0118 Regen_Blurb = Regen_Blurb & IIf(j = 1, "", ",") & Chr$(10) & "..." & rsTableControl.Fields(0) & " (" & rsTableControl.Fields(1) & ")"
0119 rsTableControl.MoveNext
0120 End If
0121 Next j
0122 Regen_Blurb = "Do you want to select these Notes? " & Regen_Blurb
0123 End If
0124 End If
0125 If i > 0 Then
0126 If MsgBox(Regen_Blurb, vbYesNo) <> vbYes Then
0127 MsgBox ("Try again then!")
0128 Exit Sub
0129 End If
0130 End If
0131 End If
0132Else
0133 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0134 If MsgBox("Do you want to regenerate ranges of Notes based on the Note_Regen_Ranges table?", vbYesNo + vbDefaultButton2) = vbYes Then
0135 Regen_Notes_Only = "Yes"
0136 Run_Type = "Ranges"
0137 Etc_Message = " ... Etc. " & Chr(10)
0138 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0139 If Not rsTableToRead.EOF Then
0140 rsTableToRead.MoveFirst
0141 NumberOfRows = rsTableToRead.RecordCount
0142 RowCount = 0
0143 StopRows = False
0144 strMessage = "Run for the following range" & IIf(rsTableToRead.RecordCount > 1, "s", "") & "?" & Chr(10) & Chr(10)
0145 Do While Not rsTableToRead.EOF
0146 RowCount = RowCount + 1
0147 If RowCount < 15 Then
0148 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)
0149 Else
0150 If StopRows = False Then
0151 If NumberOfRows > 20 Then
0152 StopRows = True
0153 strMessage = strMessage & Etc_Message
0154 Else
0155 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)
0156 End If
0157 End If
0158 End If
0159 Total_Run = Total_Run + rsTableToRead.Fields(5)
0160 rsTableToRead.MoveNext
0161 Loop
0162 strMessage = strMessage & "Total time = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0163 Else
0164 DoCmd.OpenTable ("Note_Regen_Ranges")
0165 MsgBox ("No Ranges selected. Update the Note_Regen_Ranges Table.")
0166 End
0167 End If
0168 Total_Run = 0
0169 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = False ORDER BY ID_Start;")
0170 If Not rsTableToRead.EOF Then
0171 NumberOfRows = NumberOfRows + rsTableToRead.RecordCount
0172 strMessage = strMessage & "Not selected:- " & Chr(10) & Chr(10)
0173 rsTableToRead.MoveFirst
0174 Do While Not rsTableToRead.EOF
0175 RowCount = RowCount + 1
0176 If StopRows = False Then
0177 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)
0178 End If
0179 If RowCount > 18 Then
0180 If NumberOfRows > 20 Then
0181 StopRows = True
0182 strMessage = strMessage & Etc_Message
0183 Etc_Message = ""
0184 End If
0185 End If
0186 Total_Run = Total_Run + rsTableToRead.Fields(5)
0187 rsTableToRead.MoveNext
0188 Loop
0189 strMessage = strMessage & "Total time outstanding = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0190 End If
0191 Response = MsgBox(strMessage, vbYesNo)
0192 If Response = vbNo Then
0193 DoCmd.OpenTable ("Note_Regen_Ranges")
0194 MsgBox ("Update the Note_Regen_Ranges Table.")
0195 End
0196 Else
0197 RunStartTime = Now()
0198 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Note_Regen_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0199 If Not rsTableToRead.EOF Then
0200 rsTableToRead.MoveFirst
0201 StartTime = Now()
0202 Do While Not rsTableToRead.EOF
0203 'Clear Notes_To_Regen table & ready for inserts
0204 DoCmd.RunSQL ("DELETE Notes_To_Regen.* FROM Notes_To_Regen;")
0205 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0206 'Update the table
0207 Start_Note_ID = rsTableToRead.Fields(1)
0208 End_Note_ID = rsTableToRead.Fields(2)
0209 For Temp_Note_ID = Start_Note_ID To End_Note_ID
0210 rsTableControl.AddNew
0211 rsTableControl.Fields(0) = Temp_Note_ID
0212 rsTableControl.Update
0213 Next Temp_Note_ID
0214 automatic_processing = "Yes"
0215 CreateNotesWebPages
0216 'Update the control table
0217 Duration = Now() - StartTime
0218 Duration = Duration * 24 * 60
0219 Duration = Round(Duration, 1)
0220 RunDate = Now()
0221 rsTableToRead.Edit
0222 rsTableToRead.Fields(4) = RunDate
0223 rsTableToRead.Fields(5) = Duration
0224 rsTableToRead.Update
0225 StartTime = Now()
0226 rsTableToRead.MoveNext
0227 Loop
0228 End If
0229 End If
0230 Else
0231 If MsgBox("Do you want to regenerate a bespoke range of Notes?", vbYesNo + vbDefaultButton2) = vbYes Then
0232 Regen_Notes_Only = "Yes"
0233 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_To_Regen.* FROM Notes_To_Regen;")
0234 Temp_Note_ID = InputBox("Enter Start Note ID")
0235 Temp_Note_ID = Val(Temp_Note_ID)
0236 If Temp_Note_ID > 0 Then
0237 Start_Note_ID = Temp_Note_ID
0238 Temp_Note_ID = InputBox("Enter End Note ID")
0239 Temp_Note_ID = Val(Temp_Note_ID)
0240 If Temp_Note_ID > 0 Then
0241 If Temp_Note_ID > Start_Note_ID Then
0242 End_Note_ID = Temp_Note_ID
0243 For Temp_Note_ID = Start_Note_ID To End_Note_ID
0244 rsTableControl.AddNew
0245 rsTableControl.Fields(0) = Temp_Note_ID
0246 rsTableControl.Update
0247 Next Temp_Note_ID
0248 End If
0249 End If
0250 End If
0251 End If
0252 End If
0253End If
0254If Run_Type = "Ranges" Then
0255 GoTo The_End
0256End If
0257'Check for individually-selected or range-selected Notes
0258 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;"
0259Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0260If Not rsTableToRead.EOF Then
0261 Regen_Notes_Only = "Yes"
0262 If MsgBox("Regenerate the Links?", vbYesNo + vbDefaultButton2) = vbYes Then
0263 Regenerate_the_Links = "Yes"
0264 End If
0265Else
0266 Regenerate_the_Links = "Yes"
0267 Archive_Notes_Now = "Yes"
0268 'Check if only doing Temp Notes - Read Temp Notes records
0269 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Status = ""Temp"" ORDER BY Notes_List_Auto.ID;"
0270 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0271 If Not rsTableToRead.EOF Then
0272 If MsgBox("Temp Notes only?", vbYesNo + vbDefaultButton2) = vbYes Then
0273 Archive_Notes_Now = "No"
0274 Temp_Notes_Only = "Yes"
0275 GoTo Create_Notes
0276 End If
0277 End If
0278 If MsgBox("Changed Notes only?", vbYesNo) = vbYes Then
0279 Changed_Notes_Only = "Yes"
0280 If MsgBox("Include Notes Linked to Changed Notes?", vbYesNo + vbDefaultButton2) = vbYes Then
0281 Include_Associated_Notes = "Yes"
0282 End If
0283 End If
0284End If
0285Create_Notes:
0286'Final Check ..
0287Regen_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"". "
0288If MsgBox(Regen_Blurb, vbOKCancel) = vbCancel Then
0289 Exit Sub
0290Else
0291 automatic_processing = "No"
0292 CreateNotesWebPages
0293End If
0294The_End:
0295If Run_Type = "Ranges" Then
0296 Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0297 If Duration < 1 Then
0298 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0299 MsgBox "Note Ranges Regeneration Complete in " & Duration & " seconds.", vbOKOnly, "Create Notes Webpages"
0300 Else
0301 MsgBox "Note Ranges Regeneration Complete in " & Duration & " minutes.", vbOKOnly, "Create Notes Webpages"
0302 End If
0303End If
0304End 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: 251
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 rsRefs As Recordset
0010Dim rsTopics As Recordset
0011Dim rsSubTopics As Recordset
0012Dim rsCheck As Recordset
0013 OK = Check_Database_Size()
0014Debug.Print Now() & " - Main Database size = " & Check_Database_Size & "Mb"
0015start = Now()
0016 DoCmd.RunSQL ("DELETE * FROM Paper_Citings_List_New;")
0017 DoCmd.OpenQuery ("Paper_Citings_List_New_Gen")
0018 DoCmd.RunSQL ("DELETE * FROM Book_Citings_List_New;")
0019 DoCmd.OpenQuery ("Book_Citings_List_New_Gen")
0020 DoCmd.RunSQL ("DELETE * FROM Authors_Cited_By_All_List;")
0021 DoCmd.OpenQuery ("Authors_Cited_By_All_List_Gen")
0022 DoCmd.RunSQL ("DELETE * FROM Notes_Cited_By_All_List;")
0023 DoCmd.OpenQuery ("Notes_Cited_By_All_List_Gen")
0024 DoCmd.RunSQL ("DELETE * FROM BookPaperAbstracts_List;")
0025 DoCmd.OpenQuery ("BookPaperAbstracts_List_Gen")
0026'New Year Stuff
0027If (Month(Now()) = 9 And Day(Now()) > 28) Then
0028 MsgBox ("Warning - the new academic year is about to start - you need to set things up for the new year!")
0029Else
0030 If (Month(Now()) = 10 And Day(Now()) = 1) Then 'Need to set this check up to see if I've actually done this ...
0031 MsgBox ("Warning - the new academic year has started - you need to set things up for the new year!")
0032 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
0033 'Update the Project_Plans table for the coming year (only)
0034 'Output the end-September Quarterly Summary & Task-List Reports - the last for the "Old Year". XChk & re-run without "Temp" when happy.
0035 'Copy StudyPlan.xlsx to StudyPlan_Old.xlsx
0036 'Update the Reporting_Months and Next_Reporting_Month tables
0037 'Update the Year_Crosstab_List_Prime table
0038 'Update and run the queries below ...
0039 DoCmd.OpenQuery ("Year_Crosstab_Old_Zap") 'Just needs running
0040 DoCmd.OpenQuery ("Year_Crosstab_Old_GEN") 'Just needs running
0041 DoCmd.OpenQuery ("New_Year_Crosstab_Prime_Zap") 'Update the query first!
0042 DoCmd.OpenQuery ("New_Year_Crosstab_Prime_OldYear_ADD") 'Update the query first!
0043 DoCmd.OpenQuery ("New_Year_Crosstab_Prime_NewYear_ADD") 'Just needs running
0044 DoCmd.OpenQuery ("Project_Plans_NextYear_Add") 'Just needs running. This is for the year after next - it just copies the coming year's plans
0045 'Set up StudyPlan.xlsx for the new year
0046 'Also update the Oboe-Practice report queries (Oboe_Practice_Hours_ADD, Oboe_Practice_Hours_Zeroise, Oboe_Practice_Hours_Update and Oboe_Practice_Hours_List)
0047 Stop
0048 End If
0049 End If
0050End If
0051'Ask now for use later ...
0052 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0053Question = ""
0054i = rsTableToRead.RecordCount
0055If i > 5 Then
0056 Question = MsgBox("Regenerate " & i & " Notes?", vbYesNo)
0057End If
0058'Produce Oboe-Practice report
0059 DoCmd.OpenQuery ("Oboe_Latest_Lesson_Zap")
0060 DoCmd.OpenQuery ("Oboe_Latest_Lesson_GEN")
0061 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0062 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0063 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0064 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0065 DoCmd.OpenQuery ("Oboe_Practice_Hours_ADD")
0066 DoCmd.OpenQuery ("Oboe_Practice_Hours_Zeroise")
0067 DoCmd.OpenQuery ("Oboe_Practice_Hours_Update")
0068'Since last lesson
0069 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap")
0070 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap")
0071 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN")
0072 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
0073 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Last_Lesson_Prune")
0074 DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN")
0075 DoCmd.OpenQuery ("Oboe_Practice_Hours_Latest_Lesson_Update")
0076 DoCmd.OpenQuery ("Oboe_Practice_Hours_List")
0077'Check for Object titles with Double-quotes
0078strDoubleQuote = """"""
0079strDoubleQuote = "*" & strDoubleQuote & "*"
0080 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));"
0081Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0082If Not rsCheck.EOF Then
0083 Stop
0084End If
0085 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.Item_Title) Like """ & strDoubleQuote & """));"
0086Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0087If Not rsCheck.EOF Then
0088 Stop
0089End If
0090 strQuery = "SELECT Papers.Title FROM Papers WHERE (((Papers.Title) Like """ & strDoubleQuote & """));"
0091Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0092If Not rsCheck.EOF Then
0093 Stop
0094End If
0095 strQuery = "SELECT Books.Title FROM Books WHERE (((Books.Title) Like """ & strDoubleQuote & """));"
0096Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0097If Not rsCheck.EOF Then
0098 Stop
0099End If
0100'Check for Books with Comments containing "++nnn++" style Note-links
0101 strQuery = "SELECT Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++*""));"
0102Set rsCheck = CurrentDb.OpenRecordset(strQuery)
0103If Not rsCheck.EOF Then
0104 Stop
0105End If
0106 WebpageGenDud_Abstracts_Papers
0107 WebpageGenDud_Abstracts_Books
0108'Regenerate "Time_By_Weekday_Prelist" Table
0109 DoCmd.RunSQL ("DELETE Time_By_Weekday_Prelist.* FROM Time_By_Weekday_Prelist;")
0110 DoCmd.OpenQuery ("Time_By_Weekday_Prelist_GEN")
0111'Add any idempotent Alternates for new Notes
0112 DoCmd.OpenQuery ("Note_Alternates_Add")
0113'Encode Weblinks
0114 OK = Convert_Webrefs("Author")
0115 OK = Convert_Webrefs("Book")
0116 OK = Convert_Webrefs("Note")
0117 OK = Convert_Webrefs("Note_Archive")
0118 OK = Convert_Webrefs("Paper")
0119 Update_Note_Groups_Latest_Timestamp
0120'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
0121 Set rsSubTopics = CurrentDb.OpenRecordset("SELECT * FROM [Sub-Topics] WHERE [Sub-Topics]!ID = 0;")
0122 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));")
0123If Not rsTopics.EOF Then
0124 rsTopics.MoveFirst
0125 Do Until rsTopics.EOF
0126 Set rsRefs = CurrentDb.OpenRecordset("Sub-Topics_ID_Max")
0127 rsSubTopics.AddNew
0128 rsSubTopics.Fields(0) = rsRefs.Fields(0)
0129 rsSubTopics.Fields(1) = rsTopics.Fields(1)
0130 rsSubTopics.Fields(2) = rsTopics.Fields(0)
0131 rsSubTopics.Fields(3) = rsTopics.Fields(2)
0132 rsSubTopics.Fields(4) = rsTopics.Fields(3)
0133 rsSubTopics.Update
0134 Set rsRefs = Nothing
0135 rsTopics.MoveNext
0136 Loop
0137End If
0138Set rsTopics = Nothing
0139Set rsSubTopics = Nothing
0140 DoCmd.OpenQuery ("Books_Versus_Papers_Add")
0141 DoCmd.OpenQuery ("Paper_Book_IDs_Update")
0142 DoCmd.OpenQuery ("Paper_Book_IDs_Move_Update")
0143'Delete current-year actuals prior to replacing
0144 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0145 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;")
0146 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);")
0147 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0148 DoCmd.OpenQuery ("Actual_Hours_Temp_Zap")
0149 DoCmd.OpenQuery ("Actual_Hours_Temp_GEN")
0150 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Add")
0151'Check no "orphan" actuals (current year - due to timesheet reference error, or deleted Papers)
0152 Set rsTableToRead = CurrentDb.OpenRecordset("Current_Year_Papers_Actuals_Check")
0153If Not rsTableToRead.EOF Then
0154 DoCmd.OpenQuery ("Current_Year_Papers_Actuals_Check")
0155 MsgBox ("Missing Paper(s) for Actuals Update from current year's Actuals")
0156 Stop
0157End If
0158'Update Papers total actuals (using a dummy table)
0159 DoCmd.RunSQL ("UPDATE Papers SET Papers.[Actual - Total] = 0;")
0160 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;")
0161 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));")
0162 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0163 DoCmd.OpenQuery ("Estimate - Update")
0164 DoCmd.OpenQuery ("Estimate - Update Outstanding")
0165 DoCmd.OpenQuery ("Estimate - Update Zeros From Actuals")
0166'Check no "orphan" actuals
0167 Set rsTableToRead = CurrentDb.OpenRecordset("Missing_Papers_For_Actuals")
0168If Not rsTableToRead.EOF Then
0169 DoCmd.OpenQuery ("Missing_Papers_For_Actuals")
0170 MsgBox ("Missing Paper(s) for Actuals Update")
0171 Stop
0172End If
0173 DoCmd.OpenQuery ("Notes_To_Print_Add")
0174 DoCmd.OpenQuery ("Notes_To_Print_Update")
0175 DoCmd.OpenQuery ("Books - Estimates")
0176'Update Books total actuals (using a dummy table)
0177 DoCmd.RunSQL ("UPDATE Books SET Books.[Actual - Total] = 0;")
0178 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));")
0179 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));")
0180 DoCmd.RunSQL ("DELETE * FROM Paper_Actuals_Zapper;")
0181 DoCmd.OpenQuery ("Estimate - Update Outstanding - Books")
0182 DoCmd.OpenQuery ("Author+Title_Update")
0183 DoCmd.OpenQuery ("Papers - Location Update")
0184 Find_Book_Paper_Links
0185 DoCmd.OpenQuery ("Paper_Books_Zap")
0186 DoCmd.OpenQuery ("Paper_Books_GEN")
0187 Regen_Book_Paper_Links
0188 Regen_Book_Book_Links
0189 Regen_Book_Note_Links
0190 Regen_Paper_Paper_Links
0191 Regen_Paper_Book_Links
0192 Regen_Paper_Note_Links
0193 Regen_Author_Book_Links
0194 Regen_Author_Paper_Links
0195 WebpageGenBooksRecent
0196 WebpageGenBooksRecentCategorised
0197 DoCmd.OpenQuery ("Authors_List_Authors_Table_Zap")
0198 DoCmd.OpenQuery ("Authors_List_Authors_Table_GEN")
0199 DoCmd.OpenQuery ("Authors_Add")
0200 Author_Display_Names_Convert
0201 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0202 DoCmd.OpenQuery ("Book_Abstracts_Changed")
0203 DoCmd.OpenQuery ("Book_Abstracts_Archive_Zap")
0204 DoCmd.OpenQuery ("Book_Abstracts_Archive_Add")
0205 DoCmd.OpenQuery ("Book_Abstracts_Archive_Temp_Zap")
0206'Update table that shows to display Book rather than Paper
0207 DoCmd.OpenQuery ("Book_Paper_Solitons_Zap")
0208 DoCmd.OpenQuery ("Book_Paper_Solitons_GEN")
0209'... Except where the solitary Paper has a different Author or Title to the Book
0210 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Zap")
0211 DoCmd.OpenQuery ("Book_Paper_Solitons_Zapper_Gen")
0212 DoCmd.OpenQuery ("Book_Paper_Solitons_Prune")
0213'Regenerate the triggers for Pages impacted by changed links
0214 strQuery = "DELETE Page_Regen.* FROM Page_Regen;"
0215DoCmd.RunSQL (strQuery)
0216 DoCmd.OpenQuery ("Page_Regen_GEN")
0217 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT Page_Regen.Called_ID FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N"")) GROUP BY Page_Regen.Called_ID;")
0218i = rsTableToRead.RecordCount
0219If Question = vbYes Or (i > 0 And i < 5) Then 'Asked the Question at the beginning!
0220 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0221 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;")
0222 Archive_Notes_Now = "No"
0223 Regenerate_the_Links = "No"
0224 Regen_Notes_Only = "Yes"
0225 CreateNotesWebPages ("Yes")
0226 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""));"
0227 DoCmd.RunSQL (strQuery)
0228 DoCmd.RunSQL ("DELETE * FROM Page_Regen WHERE (((Page_Regen.Called_Type) = ""N""));")
0229End If
0230Set rsTableToRead = Nothing
0231 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));")
0232 DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;")
0233 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1256));") 'Regenerate the "Dud Links" Note
0234 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
0235 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=981));") 'Regenerate the "Website - Outstanding Developments" Note
0236 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1308));") 'Regenerate the "Status: Oboe Practice" Note
0237 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
0238Archive_Notes_Now = "No"
0239Regenerate_the_Links = "No"
0240Regen_Notes_Only = "Yes"
0241 CreateNotesWebPages ("Yes")
0242 Check_Types
0243 Cross_Reference_Changes_Prune
0244Duration = Round((Now() - start) * 24 * 60, 2)
0245If Duration < 1 Then
0246 Duration = Round(Duration * 60, 0)
0247 MsgBox "Recalculation Complete in " & Duration & " seconds.", vbOKOnly, "Recalculate"
0248Else
0249 MsgBox "Recalculation Complete in " & Duration & " minutes.", vbOKOnly, "Recalculate"
0250End If
0251End 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 - Nov 2020. 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