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 11 (26 items)

Change_LinkagesChange_Linkages_NotesChange_Linkages_Notes_ArchivePrintNote
WebpageGenAuthorsWebpageGenBookCitingsWebpageGenBookPaperAbstractsWebPagesWebpageGenBooks
WebpageGenBooksCategorisedWebpageGenBooksLocationWebpageGenBooksRecentCategorisedWebpageGenBooksToNotes
WebpageGenBooksToPapersWebpageGenConcatenatedNoteGroupWebPagesWebpageGenElectronicResourcesWebpageGenIdentityPapersFull
WebpageGenIdentityPapersFullSubtopicWebpageGenIdentityPapersReadWebpageGenIdentityPapersReadSubTopicsWebpageGenPaperCitings
WebpageGenPapersToNotesWebpageGenPhilosophyPapersFullWebpageGenPhilosophyPapersFullCategorisedWebpageGenPhilosophyPapersFullCategorisedSubTopic
WebpageGenPIPageWebpageGenPrecisSubTopics..

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

Go to top of page



Source Code of: Change_Linkages
Procedure Type: Public Sub
Module: Converson_Routines
Lines of Code: 44
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Change_Linkages()
0002Dim rst As Recordset
0003Dim db As Database
0004Dim strText As String
0005Dim OK As String
0006Set db = CurrentDb
0007 Set rst = db.OpenRecordset("Select Papers.[Comments], Papers.Abstract from Papers where ((Papers.[Comments] & """" <> """") OR (Papers.Abstract & """" <> """"));")
0008If Not rst.EOF Then
0009 rst.MoveFirst
0010 Do While Not rst.EOF
0011 strText = rst.Fields(0).Value & ""
0012 'Replace
0013 If strText <> "" Then
0014 OK = ReplaceCode(strText, "*P", "+P")
0015 strText = ReplaceCode(OK, "*B", "+B")
0016 OK = ReplaceCode(strText, "*N", "+N")
0017 strText = ReplaceCode(OK, "P*", "P+")
0018 OK = ReplaceCode(strText, "B*", "B+")
0019 strText = ReplaceCode(OK, "N*", "N+")
0020 OK = ReplaceCode(strText, "**", "++")
0021 'Update
0022 rst.Edit
0023 rst.Fields(0).Value = OK
0024 rst.Update
0025 End If
0026 strText = rst.Fields(1).Value & ""
0027 'Replace
0028 If strText <> "" Then
0029 OK = ReplaceCode(strText, "*P", "+P")
0030 strText = ReplaceCode(OK, "*B", "+B")
0031 OK = ReplaceCode(strText, "*N", "+N")
0032 strText = ReplaceCode(OK, "P*", "P+")
0033 OK = ReplaceCode(strText, "B*", "B+")
0034 strText = ReplaceCode(OK, "N*", "N+")
0035 OK = ReplaceCode(strText, "**", "++")
0036 'Update
0037 rst.Edit
0038 rst.Fields(1).Value = OK
0039 rst.Update
0040 End If
0041 rst.MoveNext
0042 Loop
0043End If
0044End Sub

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


Source Code of: Change_Linkages_Notes
Procedure Type: Public Sub
Module: Converson_Routines
Lines of Code: 32
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Change_Linkages_Notes()
0002Dim rst As Recordset
0003Dim db As Database
0004Dim strText As String
0005Dim OK As String
0006Set db = CurrentDb
0007 Set rst = db.OpenRecordset("Select Notes.[Item_Text] from Notes;")
0008If Not rst.EOF Then
0009 rst.MoveFirst
0010 Do While Not rst.EOF
0011 strText = rst.Fields(0).Value & ""
0012 'Replace
0013 If strText <> "" Then
0014 OK = ReplaceCode(strText, "*P", "+P")
0015 strText = ReplaceCode(OK, "*B", "+B")
0016 OK = ReplaceCode(strText, "*N", "+N")
0017 strText = ReplaceCode(OK, "P*", "P+")
0018 OK = ReplaceCode(strText, "B*", "B+")
0019 strText = ReplaceCode(OK, "N*", "N+")
0020 OK = ReplaceCode(strText, "**", "++")
0021 strText = ReplaceCode(OK, "P+*", "p++")
0022 OK = ReplaceCode(strText, "B+*", "b++")
0023 strText = ReplaceCode(OK, "N+*", "n++")
0024 'Update
0025 rst.Edit
0026 rst.Fields(0).Value = OK
0027 rst.Update
0028 End If
0029 rst.MoveNext
0030 Loop
0031End If
0032End Sub

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


Source Code of: Change_Linkages_Notes_Archive
Procedure Type: Public Sub
Module: Converson_Routines
Lines of Code: 32
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Change_Linkages_Notes_Archive()
0002Dim rst As Recordset
0003Dim db As Database
0004Dim strText As String
0005Dim OK As String
0006Set db = CurrentDb
0007 Set rst = db.OpenRecordset("Select Notes_Archive.[Item_Text] from Notes_Archive;")
0008If Not rst.EOF Then
0009 rst.MoveFirst
0010 Do While Not rst.EOF
0011 strText = rst.Fields(0).Value & ""
0012 'Replace
0013 If strText <> "" Then
0014 OK = ReplaceCode(strText, "*P", "+P")
0015 strText = ReplaceCode(OK, "*B", "+B")
0016 OK = ReplaceCode(strText, "*N", "+N")
0017 strText = ReplaceCode(OK, "P*", "P+")
0018 OK = ReplaceCode(strText, "B*", "B+")
0019 strText = ReplaceCode(OK, "N*", "N+")
0020 OK = ReplaceCode(strText, "**", "++")
0021 strText = ReplaceCode(OK, "P+*", "p++")
0022 OK = ReplaceCode(strText, "B+*", "b++")
0023 strText = ReplaceCode(OK, "N+*", "n++")
0024 'Update
0025 rst.Edit
0026 rst.Fields(0).Value = OK
0027 rst.Update
0028 End If
0029 rst.MoveNext
0030 Loop
0031End If
0032End Sub

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


Source Code of: PrintNote
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 96
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub PrintNote()
0002Dim iFootNoteID As Variant
0003Dim maxDepth As Integer
0004Dim SuppressPrivate As Variant
0005Dim strQuery As String
0006Dim rsTableControl As Recordset
0007Dim Duration, StartTime, Secure, Timestamp, Processed
0008'Check for Temp Notes
0009 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes.ID FROM Notes WHERE (((Notes.Status)=""Temp""));")
0010If Not rsTableControl.EOF Then
0011 If MsgBox("There are ""Temp"" Notes in the database and if referenced they will be printed (though not copied to the Transfer directory). Proceed?", vbYesNo) = vbNo Then
0012 Exit Sub
0013 End If
0014End If
0015Set rsTableControl = Nothing
0016If MsgBox("Do you want to print all Notes specified in the Notes_to_Print table?", vbYesNo, "Automatic?") = vbYes Then
0017 StartTime = Now()
0018 Regen_Note_Links
0019 strQuery = "SELECT Notes_to_Print.Note_ID, Notes_to_Print.Max_Depth, Notes_to_Print.Private, Notes_to_Print.Print_ReadingList, Notes_to_Print.Print_DupNoteRefs, Notes.Note_Group, Notes.Last_Changed, Note_Print_Links.[Processed?] FROM (Notes_to_Print INNER JOIN Notes ON Notes_to_Print.Note_ID = Notes.ID) LEFT JOIN Note_Print_Links ON (Notes.ID = Note_Print_Links.Note_ID) AND (Notes.Last_Changed = Note_Print_Links.Timestamp) WHERE Notes_to_Print.Current = -1 ORDER BY Notes_to_Print.Note_ID, Notes_to_Print.Max_Depth;"
0020 Set rsTableControl = CurrentDb.OpenRecordset(strQuery)
0021 If Not rsTableControl.EOF Then
0022 rsTableControl.MoveFirst
0023 Do While Not rsTableControl.EOF
0024 iFootNoteID = rsTableControl.Fields(0).Value
0025 maxDepth = rsTableControl.Fields(1).Value
0026 SuppressPrivate = rsTableControl.Fields(2).Value
0027 strPrintReadingLists = rsTableControl.Fields(3).Value
0028 strPrintDuplicateFootnoteRefs = rsTableControl.Fields(4).Value
0029 Secure = rsTableControl.Fields(5).Value 'Notes Group 10 is "Secure"
0030 Timestamp = rsTableControl.Fields(6) & ""
0031 Processed = rsTableControl.Fields(7) & ""
0032 OK = NoteForPrinting(iFootNoteID, maxDepth, SuppressPrivate, Secure, Timestamp, Processed)
0033 rsTableControl.MoveNext
0034 Loop
0035 End If
0036 'Flag any archive-prints as done
0037 DoCmd.RunSQL ("UPDATE Note_Print_Links SET Note_Print_Links.[Processed?] = ""Yes"";")
0038Else
0039 iFootNoteID = InputBox("Which Footnote ID? Press ""Cancel"" to escape!", "Footnote ID", 1)
0040 If Len(iFootNoteID) = 0 Then
0041 Exit Sub
0042 End If
0043 strQuery = "SELECT Notes.Note_Group FROM Notes WHERE (((Notes.ID)=" & iFootNoteID & "));"
0044 Set rsTableControl = CurrentDb.OpenRecordset(strQuery)
0045 If Not rsTableControl.EOF Then
0046 rsTableControl.MoveFirst
0047 Secure = rsTableControl.Fields(0)
0048 Else
0049 MsgBox ("Note does not exist!")
0050 Exit Sub
0051 End If
0052 maxDepth = InputBox("How many levels of Footnotes?", "Footnote Levels", 1)
0053 If Len(maxDepth) = 0 Then
0054 Exit Sub
0055 End If
0056 If MsgBox("Suppress Private Footnotes?", vbYesNo, "Private Footnotes?") = vbYes Then
0057 SuppressPrivate = "Yes"
0058 Else
0059 SuppressPrivate = "No"
0060 End If
0061 If MsgBox("Suppress Reading Lists?", vbYesNo, "Reading Lists?") = vbYes Then
0062 strPrintReadingLists = "No"
0063 Else
0064 strPrintReadingLists = "Yes"
0065 End If
0066 If MsgBox("Suppress References to Duplicate Notes?", vbYesNo, "Duplicate Notes?") = vbYes Then
0067 strPrintDuplicateFootnoteRefs = "No"
0068 Else
0069 strPrintDuplicateFootnoteRefs = "Yes"
0070 End If
0071 StartTime = Now()
0072 Regen_Note_Links
0073 strQuery = "SELECT Note_Print_Links.Timestamp, Note_Print_Links.[Processed?] FROM Note_Print_Links WHERE (((Note_Print_Links.[Processed?])=""No"") AND ((Note_Print_Links.Note_ID)=" & iFootNoteID & "));"
0074 Set rsTableControl = CurrentDb.OpenRecordset(strQuery)
0075 If Not rsTableControl.EOF Then
0076 rsTableControl.MoveFirst
0077 Timestamp = rsTableControl.Fields(0)
0078 Processed = rsTableControl.Fields(1)
0079 Else
0080 Timestamp = ""
0081 Processed = ""
0082 End If
0083 OK = NoteForPrinting(iFootNoteID, maxDepth, SuppressPrivate, Secure, Timestamp, Processed)
0084 'Flag any archive-print as done
0085 If Timestamp <> "" Then
0086 DoCmd.RunSQL ("UPDATE Note_Print_Links SET Note_Print_Links.[Processed?] = ""Yes"" WHERE (((Note_Print_Links.Timestamp)=" & Timestamp & ") AND ((Note_Print_Links.Note_ID)=" & iFootNoteID & "));")
0087 End If
0088End If
0089Duration = Round((Now() - StartTime) * 24 * 60, 1)
0090If Duration < 1 Then
0091 Duration = Round((Now() - StartTime) * 24 * 60 * 60)
0092 MsgBox "Printable notes output OK in " & Duration & " seconds.", vbOKOnly, "Printable Notes"
0093Else
0094 MsgBox "Printable notes output OK in " & Duration & " minutes.", vbOKOnly, "Printable Notes"
0095End If
0096End Sub

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


Source Code of: WebpageGenAuthors
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 112
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenAuthors()
0002Dim rsTableToRead As Recordset
0003Dim Response
0004Dim Author As String
0005Dim Blurb As String
0006Dim strMessage As String
0007Dim Total_Run As Single
0008Dim Run_Type As String
0009 strControlTable = "Authors"
0010strOutputFileShort = "Author"
0011strOutputFolder = TheoWebsiteRoot & "\Authors\"
0012strOutputFile = ""
0013Total_Run = 0
0014If automatic_processing <> "Yes" Then
0015 Response = MsgBox("Do you want to regenerate pages for (potentially) changed Author-Lists only?", vbYesNoCancel)
0016Else
0017 Response = vbYes
0018End If
0019If Response = vbYes Then
0020 strDataQuery = "Authors_List_Changed"
0021 Run_Type = "Changed"
0022Else
0023 Run_Type = "Regen"
0024 If Response = vbNo Then
0025 Response = MsgBox("Do you want to regenerate pages for Authors starting with a particular letter?", vbYesNoCancel)
0026 If Response = vbYes Then
0027 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Author_Letters WHERE [Select?] = True ORDER BY Author_Letter;")
0028 If Not rsTableToRead.EOF Then
0029 rsTableToRead.MoveFirst
0030 strMessage = "Run for the following letter" & IIf(rsTableToRead.RecordCount > 1, "s", "") & "?" & Chr(10) & Chr(10)
0031 Do While Not rsTableToRead.EOF
0032 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & Round(rsTableToRead.Fields(3), 0) & " mins (" & Round(rsTableToRead.Fields(2), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(2))), 0) & " days)" & Chr(10)
0033 Total_Run = Total_Run + rsTableToRead.Fields(3)
0034 rsTableToRead.MoveNext
0035 Loop
0036 strMessage = strMessage & "Total time = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0037 Else
0038 DoCmd.OpenTable ("Author_Letters")
0039 MsgBox ("No Letters selected. Update the Author_Letters Table.")
0040 End
0041 End If
0042 Total_Run = 0
0043 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Author_Letters WHERE [Select?] = False ORDER BY Author_Letter;")
0044 If Not rsTableToRead.EOF Then
0045 strMessage = strMessage & "Not selected:- " & Chr(10) & Chr(10)
0046 rsTableToRead.MoveFirst
0047 Do While Not rsTableToRead.EOF
0048 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & Round(rsTableToRead.Fields(3), 0) & " mins (" & Round(rsTableToRead.Fields(2), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(2))), 0) & " days)" & Chr(10)
0049 Total_Run = Total_Run + rsTableToRead.Fields(3)
0050 rsTableToRead.MoveNext
0051 Loop
0052 strMessage = strMessage & "Total time outstanding = " & Round(Total_Run, 0) & " mins." & Chr(10) & Chr(10)
0053 End If
0054 Response = MsgBox(strMessage, vbYesNo)
0055 If Response = vbNo Then
0056 DoCmd.OpenTable ("Author_Letters")
0057 MsgBox ("Update the Author_Letters Table.")
0058 End
0059 Else
0060 strDataQuery = "Authors_List_Letter"
0061 DoCmd.OpenQuery ("Authors_List_Letter_Table_Zap")
0062 DoCmd.OpenQuery ("Authors_List_Letter_Table_GEN")
0063 Run_Type = "Regen_Letters"
0064 End If
0065 Else
0066 If Response = vbNo Then
0067 Response = MsgBox("Do you want to regenerate pages for a particular Authors or Authors?", vbYesNoCancel)
0068 If Response = vbYes Then
0069 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Author_Parameter;")
0070 If rsTableToRead.EOF Then
0071 DoCmd.OpenTable ("Author_Parameter")
0072 MsgBox ("Update the Author_Parameter Table.")
0073 End
0074 Else
0075 rsTableToRead.MoveFirst
0076 DoEvents
0077 Author = rsTableToRead.Fields(0).Value
0078 rsTableToRead.MoveLast
0079 If rsTableToRead.RecordCount = 1 Then
0080 Blurb = Author
0081 Else
0082 Blurb = rsTableToRead.RecordCount & " authors from " & Author & " to " & rsTableToRead.Fields(0)
0083 End If
0084 DoEvents
0085 Response = MsgBox("Do you want to run for " & Blurb & "? If not, update the Author_Parameter Table.", vbYesNoCancel)
0086 If Response = vbYes Then
0087 strDataQuery = "Authors_List_Selected_Authors"
0088 Else
0089 DoCmd.OpenTable ("Author_Parameter")
0090 End
0091 End If
0092 End If
0093 End If
0094 End If
0095 End If
0096 End If
0097End If
0098If Response <> vbCancel Then
0099 CreateAuthorsWebPages (Run_Type)
0100 If automatic_processing <> "Yes" Then
0101 Response = MsgBox("Do you want to regenerate the Authors Summary Pages?", vbYesNo)
0102 Else
0103 Response = vbYes
0104 End If
0105 If Response = vbYes Then
0106 WebpageGenAuthorsSummary
0107 If automatic_processing <> "Yes" Then
0108 MsgBox ("Authors Summary Pages produced OK")
0109 End If
0110 End If
0111End If
0112End Sub

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


Source Code of: WebpageGenBookCitings
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 33
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBookCitings(Optional Automatic)
0002'Two sorts of "automatic"!
0003strControlTable = "BookCitings"
0004strOutputFileShort = "BookCitings"
0005strOutputFolder = TheoWebsiteRoot & "\BookSummaries\"
0006strOutputFile = ""
0007Dim Response
0008Dim strAutomatic As String
0009If IsMissing(Automatic) Then
0010 strAutomatic = "No"
0011Else
0012 strAutomatic = Automatic
0013End If
0014If strAutomatic = "No" Then
0015 If automatic_processing <> "Yes" Then
0016 Response = MsgBox("Do you want to regenerate pages for (potentially) changed Book-Citings only?", vbYesNoCancel)
0017 Else
0018 Response = vbYes
0019 strAutomatic = "Yes"
0020 End If
0021Else
0022 Response = vbNo
0023End If
0024If Response = vbYes Then
0025 strDataQuery = "Book_Citings_List_Changed_New"
0026 CreateBookCitingsWebPages (strAutomatic)
0027Else
0028 If Response = vbNo Then
0029 strDataQuery = "Book_Citings_List_New_List"
0030 CreateBookCitingsWebPages (strAutomatic)
0031 End If
0032End If
0033End Sub

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


Source Code of: WebpageGenBookPaperAbstractsWebPages
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 8

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBookPaperAbstractsWebPages()
0002strControlTable = "BookPaperAbstracts"
0003strOutputFileShort = "BookPaperAbstracts"
0004strOutputFolder = TheoWebsiteRoot & "\BookSummaries\"
0005strOutputFile = ""
0006 strDataQuery = "BookPaperAbstracts_List"
0007 CreateBookPaperAbstractsWebPages
0008End Sub

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


Source Code of: WebpageGenBooks
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooks()
0002strControlTable = "Books_Table_Full"
0003strOutputFileShort = "BookCatalog"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Books - All"
0007strSplitTable = "Yes"
0008strControlBreakType = "Initial"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenBooksCategorised
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 14

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooksCategorised()
0002strControlTable = "Books_Table_Full_Categorised"
0003strOutputFileShort = "BookCatalogCategorised"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Books - All - Categorised"
0007DoCmd.RunSQL ("DELETE [" & strDataQuery & "_Table].* FROM [" & strDataQuery & "_Table];")
0008 DoCmd.OpenQuery (strDataQuery & "_Table_GEN")
0009strSplitTable = "Yes"
0010strControlBreakType = "SubTopic"
0011strControlBreakType2 = "2-Level"
0012Main_Header = "Yes"
0013 CreatePapersWebTable
0014End Sub

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


Source Code of: WebpageGenBooksLocation
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 15

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooksLocation()
0002strControlTable = "Books_Table_Location"
0003strOutputFileShort = "BookCatalogLocation"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Books_Locations"
0007 DoCmd.RunSQL ("DELETE [Books_Locations_Table].* FROM [Books_Locations_Table];")
0008 DoCmd.OpenQuery ("Books_Locations_Table_GEN")
0009 DoCmd.RunSQL ("UPDATE Books_Locations_Table SET Books_Locations_Table.Category = Replace([Category],"" - Unclassified"","""") WHERE (((Books_Locations_Table.Category) Like ""* - Unclassified*""));")
0010strSplitTable = "Yes"
0011strControlBreakType = "SubTopic"
0012strControlBreakType2 = "2-Level"
0013Main_Header = "Yes"
0014 CreatePapersWebTable
0015End Sub

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


Source Code of: WebpageGenBooksRecentCategorised
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooksRecentCategorised()
0002Dim StartTime As Double
0003Dim rsTableToRead As Recordset
0004Dim Duration As Double
0005Dim strRunTime As String
0006Dim RunDate As Date
0007 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenBooksRecentCategorised"";")
0008RunDate = rsTableToRead.Fields(1)
0009strRunTime = Round(rsTableToRead.Fields(2), 1)
0010StartTime = Now()
0011strControlTable = "Books_Table_Recent_Categorised"
0012strOutputFileShort = "BookCatalogRecentCategorised"
0013strOutputFolder = TheoWebsiteRoot & "\"
0014strOutputFile = strOutputFolder & strOutputFileShort
0015 strDataQuery = "Books - Recent - Categorised"
0016strSplitTable = "No"
0017strControlBreakType = "SubTopic"
0018strControlBreakType2 = ""
0019Main_Header = "No"
0020 CreatePapersWebTable
0021Duration = Round((Now() - StartTime) * 24 * 60, 1)
0022rsTableToRead.Edit
0023rsTableToRead.Fields(1) = Now()
0024rsTableToRead.Fields(2) = Duration
0025rsTableToRead.Update
0026Set rsTableToRead = Nothing
0027End Sub

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


Source Code of: WebpageGenBooksToNotes
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 8

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooksToNotes()
0002strControlTable = "Books_To_Notes"
0003strOutputFileShort = "BooksToNotes"
0004strOutputFolder = TheoWebsiteRoot & "\BookSummaries\"
0005strOutputFile = ""
0006 strDataQuery = "Book_Note_Link_List"
0007 CreatePapersToNotesWebPages ("Book")
0008End Sub

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


Source Code of: WebpageGenBooksToPapers
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 9

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooksToPapers()
0002strControlTable = "Books_To_Papers"
0003automatic_processing = "No"
0004strOutputFileShort = "BooksToPapers"
0005strOutputFolder = TheoWebsiteRoot & "\BookSummaries\"
0006strOutputFile = ""
0007 strDataQuery = "Books_Versus_Papers_List"
0008 CreatePapersToBooksWebPages
0009End Sub

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


Source Code of: WebpageGenConcatenatedNoteGroupWebPages
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 53
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenConcatenatedNoteGroupWebPages()
0002Dim x As String
0003Dim Y As Integer
0004Dim MaxID As Integer
0005Dim rsTableControl As Recordset
0006Dim rsNoteGroup As Recordset
0007Dim strMessage As String
0008 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Max(ID) FROM Note_Groups;")
0009rsTableControl.MoveFirst
0010MaxID = rsTableControl.Fields(0)
0011 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Note_Groups.Note_Group, Note_Groups.ID, Note_Groups.Time_To_Concatenate, IIf([Latest_Note_Update]>[Latest_Concatenation],Round([Latest_Note_Update]-[Latest_Concatenation],0),0) AS Expr1, Note_Groups.Latest_Concatenation FROM Note_Groups ORDER BY Note_Groups.Note_Group;")
0012strMessage = "Enter Note Group ID: (Mins; Last Output)" & Chr(10) & Chr(10)
0013rsTableControl.MoveFirst
0014Do While Not rsTableControl.EOF
0015 strMessage = strMessage & rsTableControl.Fields(1) & ": " & rsTableControl.Fields(0)
0016 strMessage = strMessage & IIf(rsTableControl.Fields(2) & "" <> "", " (" & Round(rsTableControl.Fields(2), 0) & "; " & IIf(Left(rsTableControl.Fields(4), 10) = Left(Now(), 10), Mid(rsTableControl.Fields(4), 11, 100), Left(rsTableControl.Fields(4), 10)) & ")", " ")
0017 strMessage = strMessage & IIf(rsTableControl.Fields(3) <> 0, Chr$(10) & " ... " & rsTableControl.Fields(3) & " days out of date. ", "") & Chr(10)
0018 rsTableControl.MoveNext
0019Loop
0020strControlTable = "ConcatenatedNoteGroup"
0021Y = 200
0022Do While Y > 100
0023 x = InputBox(strMessage, "Choose a Notes Group")
0024 If x = "" Then
0025 Exit Sub
0026 End If
0027 If IsNumeric(x) Then
0028 Y = x
0029 If Y > 0 And Y < MaxID + 1 Then
0030 Else
0031 Y = 200
0032 End If
0033 End If
0034Loop
0035 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Note_Group FROM Note_Groups WHERE ID = " & Y & ";")
0036rsTableControl.MoveFirst
0037Notes_Group = rsTableControl.Fields(0)
0038strOutputFileShort = Replace(Notes_Group, " ", "")
0039strOutputFileShort = strOutputFileShort & "ConcatenatedNotes"
0040strOutputFolder = TheoWebsiteRoot & "\"
0041strOutputFile = ""
0042 strDataQuery = "Notes_List_Group"
0043Notes_Group_ID = Y
0044'Re-create Note_Group_Select
0045 DoCmd.RunSQL ("Delete * from Note_Group_Select;")
0046 Set rsNoteGroup = CurrentDb.OpenRecordset("Select * from Note_Group_Select;")
0047rsNoteGroup.AddNew
0048rsNoteGroup.Fields(0) = Notes_Group_ID
0049rsNoteGroup.Update
0050Set rsTableControl = Nothing
0051 CreateConcatenatedNoteGroupWebPages
0052Set rsNoteGroup = Nothing
0053End Sub

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


Source Code of: WebpageGenElectronicResources
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenElectronicResources()
0002strControlTable = "Electronic_Resources"
0003strOutputFileShort = "Electronic_Resources"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Electronic Resources"
0007strSplitTable = "Yes"
0008strControlBreakType = "Initial"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenIdentityPapersFull
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenIdentityPapersFull()
0002strControlTable = "Identity_Paper_Table_Full"
0003strOutputFileShort = "PaperCatalogIdentityFull"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Identity Papers - Abstracts - Full"
0007strSplitTable = "Yes"
0008strControlBreakType = "Initial"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenIdentityPapersFullSubtopic
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenIdentityPapersFullSubtopic()
0002strControlTable = "Identity_Paper_Table_Full_Subtopic"
0003strOutputFileShort = "PaperCatalogIdentityFullSubTopic"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Identity Papers - Abstracts - Full - SubTopic"
0007strSplitTable = "Yes"
0008strControlBreakType = "SubTopic"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenIdentityPapersRead
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenIdentityPapersRead()
0002strControlTable = "Identity_Paper_Table_Read"
0003strOutputFileShort = "PaperCatalogIdentityRead"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Identity Papers - Abstracts - Read"
0007strSplitTable = "Yes"
0008strControlBreakType = "Initial"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenIdentityPapersReadSubTopics
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenIdentityPapersReadSubTopics()
0002strControlTable = "Identity_Paper_Table_Read_Subtopic"
0003strOutputFileShort = "PaperCatalogIdentityReadSubTopic"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Identity Papers - Abstracts - Read - SubTopic"
0007strSplitTable = "Yes"
0008strControlBreakType = "SubTopic"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenPaperCitings
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 33
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPaperCitings(Optional Automatic)
0002'Two sorts of "automatic"!
0003strControlTable = "PaperCitings"
0004strOutputFileShort = "PaperCitings"
0005strOutputFolder = TheoWebsiteRoot & "\PaperSummaries\"
0006strOutputFile = ""
0007Dim Response
0008Dim strAutomatic As String
0009If IsMissing(Automatic) Then
0010 strAutomatic = "No"
0011Else
0012 strAutomatic = Automatic
0013End If
0014If strAutomatic = "No" Then
0015 If automatic_processing <> "Yes" Then
0016 Response = MsgBox("Do you want to regenerate pages for (potentially) changed Paper-Citings only?", vbYesNoCancel)
0017 Else
0018 Response = vbYes
0019 strAutomatic = "Yes"
0020 End If
0021Else
0022 Response = vbNo
0023End If
0024If Response = vbYes Then
0025 strDataQuery = "Paper_Citings_List_Changed_New"
0026 CreatePaperCitingsWebPages (strAutomatic)
0027Else
0028 If Response = vbNo Then
0029 strDataQuery = "Paper_Citings_List_New_List"
0030 CreatePaperCitingsWebPages (strAutomatic)
0031 End If
0032End If
0033End Sub

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


Source Code of: WebpageGenPapersToNotes
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 8

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPapersToNotes()
0002strControlTable = "Papers_To_Notes"
0003strOutputFileShort = "PapersToNotes"
0004strOutputFolder = TheoWebsiteRoot & "\PaperSummaries\"
0005strOutputFile = ""
0006 strDataQuery = "Paper_Note_Link_List"
0007 CreatePapersToNotesWebPages ("Paper")
0008End Sub

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


Source Code of: WebpageGenPhilosophyPapersFull
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPhilosophyPapersFull()
0002strControlTable = "Philosophy_Paper_Table_Full"
0003strOutputFileShort = "PaperCatalogPhilosophyFull"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Philosophy Papers - All"
0007strSplitTable = "Yes"
0008strControlBreakType = "Initial"
0009strControlBreakType2 = ""
0010Main_Header = "Yes"
0011 CreatePapersWebTable
0012End Sub

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


Source Code of: WebpageGenPhilosophyPapersFullCategorised
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 38
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPhilosophyPapersFullCategorised()
0002Dim rsQuery As Recordset
0003Dim strMsg As String
0004Dim strQuery As String
0005strControlTable = "Philosophy_Paper_Table_Full_Categorised"
0006strOutputFileShort = "PaperCatalogPhilosophyFullCategorised"
0007strOutputFolder = TheoWebsiteRoot & "\"
0008strOutputFile = strOutputFolder & strOutputFileShort
0009 strQuery = "Subject_Topic_Unclassifieds"
0010 strMsg = "WebpageGenPhilosophyPapersFullCategorised: Exiting!! Some tidying up to do first! Set the ""Unclassified"" Topic to the Subject for the papers in query """ & strQuery & """, then run this Sub."
0011 Set rsQuery = CurrentDb.OpenRecordset("Subject_Topic_Unclassifieds")
0012If Not rsQuery.EOF Then
0013 DoCmd.OpenQuery ("Subject_Topic_Unclassifieds")
0014 Debug.Print Now() & " - "; strMsg
0015 If automatic_processing <> "Yes" Then
0016 MsgBox (strMsg)
0017 End If
0018 Exit Sub
0019End If
0020 strDataQuery = "Philosophy Papers - All - Categorised"
0021DoCmd.RunSQL ("DELETE [" & strDataQuery & "_Table].* FROM [" & strDataQuery & "_Table];")
0022 DoCmd.OpenQuery (strDataQuery & "_Table_GEN")
0023 strDataQuery = "Philosophy Papers - All - Categorised (Titles)"
0024DoCmd.RunSQL ("DELETE [" & strDataQuery & "_Table].* FROM [" & strDataQuery & "_Table];")
0025 DoCmd.OpenQuery (strDataQuery & "_Table_GEN")
0026 strDataQuery = "Philosophy Papers - All - Categorised (Titles) - Top"
0027DoCmd.RunSQL ("DELETE [" & strDataQuery & "_Table].* FROM [" & strDataQuery & "_Table];")
0028 DoCmd.OpenQuery (strDataQuery & "_Table_GEN")
0029 strDataQuery = "Philosophy Papers - All - Categorised (Titles) - Solitons"
0030DoCmd.RunSQL ("DELETE [" & strDataQuery & "_Table].* FROM [" & strDataQuery & "_Table];")
0031 DoCmd.OpenQuery (strDataQuery & "_GEN") 'Query-name too long for "_Table" !
0032 strDataQuery = "Philosophy Papers - All - Categorised"
0033strSplitTable = "Yes"
0034strControlBreakType = "SubTopic"
0035strControlBreakType2 = "2-Level"
0036Main_Header = "Yes"
0037 CreatePapersWebTable
0038End Sub

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


Source Code of: WebpageGenPhilosophyPapersFullCategorisedSubTopic
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 14

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPhilosophyPapersFullCategorisedSubTopic()
0002strControlTable = "Philosophy_Paper_Table_Full_Categorised_SubTopic"
0003strOutputFileShort = "PaperCatalogPhilosophyFullCategorisedSubTopic"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Papers - All - Categorised - Sub"
0007DoCmd.RunSQL ("DELETE [" & strDataQuery & "_Table].* FROM [" & strDataQuery & "_Table];")
0008 DoCmd.OpenQuery (strDataQuery & "_Table_GEN")
0009strSplitTable = "Yes"
0010strControlBreakType = "SubTopic"
0011strControlBreakType2 = "2-Level"
0012Main_Header = "Yes"
0013 CreatePapersWebTable
0014End Sub

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


Source Code of: WebpageGenPIPage
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 15

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPIPage()
0002 strControlTable = "Philosophers_Index"
0003 strOutputFileShort = "Philosophers_Index_List_OA"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006'THIS PAGE IS DUD - IN THAT IT ONLY CONTAINS ITEMS ON THE ONTOLOGICAL ARGUMENT, AND PRODUCES LOTS OF FAILED AUTHOR LINKS
0007 strDataQuery = "Philosophers_Index_List_OA"
0008strSplitTable = "No"
0009strControlBreakType = "Initial"
0010strControlBreakType2 = ""
0011Main_Header = "No"
0012OK = MsgBox("This is a generic routine for generating pages from my Philosophers Index database using strDataQuery. But the database is very out of date and the page generator creates lots of broken links for Authors. ")
0013End
0014 CreatePapersWebTable
0015End Sub

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


Source Code of: WebpageGenPrecisSubTopics
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 12

Line-No. / Ref.Code Line
0001Public Sub WebpageGenPrecisSubTopics()
0002strControlTable = "Precis_Table_Read_Subtopic"
0003strOutputFileShort = "PrecisCatalogSubTopic"
0004strOutputFolder = TheoWebsiteRoot & "\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Precis_Web_Gen"
0007strSplitTable = "No"
0008strControlBreakType = "SubTopic"
0009strControlBreakType2 = ""
0010Main_Header = "No"
0011 CreatePapersWebTable
0012End Sub

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


© Theo Todman, June 2007 - April 2026. 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