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 33 (2 items)

cmdRegenerateArchivedNote_ClickOutputNotesWebPage..

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

Go to top of page




Source Code of: cmdRegenerateArchivedNote_Click
Procedure Type: Private Sub
Module: Form_Notes_Archive_Regen
Lines of Code: 88
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdRegenerateArchivedNote_Click()
0002Dim Note_ID As Integer
0003Dim Note_Timestamp As Long
0004Dim StartTime As Date
0005Dim Duration
0006Dim rsTableToRead As Recordset
0007Dim strQuery As String
0008Dim i As Long
0009Dim ID_Start As Integer
0010i = 0
0011ID_Start = 0
0012If [Forms]![Notes_Archive_Regen]![Combo1] & "" = "" Then
0013 If [Forms]![Notes_Archive_Regen]![Combo5] & "" <> "" Then
0014 If MsgBox("Do you want to regenerate all the archived Notes >= a certain ID?", vbYesNo) = vbYes Then
0015 StartTime = Now()
0016 ID_Start = Val([Forms]![Notes_Archive_Regen]![Combo5])
0017 If ID_Start > 0 Then
0018 GoTo TheLot
0019 Else
0020 MsgBox ("Parameters entered incorrectly; try again!")
0021 End If
0022 Else
0023 MsgBox ("Enter the parameters then!")
0024 End If
0025 Else
0026 If MsgBox("Do you want to regenerate all the archived Notes?", vbYesNo) = vbYes Then
0027 StartTime = Now()
0028 GoTo TheLot
0029 Else
0030 MsgBox ("Enter the parameters then!")
0031 End If
0032 End If
0033Else
0034 Note_ID = [Forms]![Notes_Archive_Regen]![Combo1]
0035 If [Forms]![Notes_Archive_Regen]![Combo3] & "" = "" Then
0036 If MsgBox("Do you want to regenerate all the archived Notes for Note " & Note_ID & "?", vbYesNo) = vbYes Then
0037 StartTime = Now()
0038 GoTo AllForANote
0039 Else
0040 MsgBox ("Enter the Timestamp parameter then!")
0041 End If
0042 Else
0043 Note_Timestamp = [Forms]![Notes_Archive_Regen]![Combo3]
0044 StartTime = Now()
0045 OK = OutputNotesWebPage_Archived(Note_ID, Note_Timestamp)
0046 i = 1
0047 End If
0048End If
0049GoTo TheEnd
0050AllForANote:
0051i = 0
0052 strQuery = "SELECT [ID], [Timestamp] FROM Notes_Archive WHERE [ID] = " & Note_ID & " ORDER BY [ID], [Timestamp]; "
0053Set rsTableToRead = CurrentDb.OpenRecordset(strQuery)
0054If Not rsTableToRead.EOF Then
0055 rsTableToRead.MoveFirst
0056 Do While Not rsTableToRead.EOF
0057 Note_ID = rsTableToRead.Fields(0)
0058 Note_Timestamp = rsTableToRead.Fields(1)
0059 OK = OutputNotesWebPage_Archived(Note_ID, Note_Timestamp)
0060 rsTableToRead.MoveNext
0061 i = i + 1
0062 Loop
0063End If
0064GoTo TheEnd
0065TheLot:
0066i = 0
0067 strQuery = "SELECT [ID], [Timestamp] FROM Notes_Archive WHERE [ID] >= " & ID_Start & " ORDER BY [ID], [Timestamp]; "
0068Set rsTableToRead = CurrentDb.OpenRecordset(strQuery)
0069If Not rsTableToRead.EOF Then
0070 rsTableToRead.MoveFirst
0071 Do While Not rsTableToRead.EOF
0072 Note_ID = rsTableToRead.Fields(0)
0073 Note_Timestamp = rsTableToRead.Fields(1)
0074 OK = OutputNotesWebPage_Archived(Note_ID, Note_Timestamp)
0075 rsTableToRead.MoveNext
0076 i = i + 1
0077 Loop
0078End If
0079TheEnd:
0080Duration = (Now() - StartTime) * 24 * 60
0081If Duration < 1 Then
0082 Duration = Round(Duration * 60)
0083 MsgBox Now() & ": Notes Archive Webpage Creation Complete in " & Duration & " seconds. " & i & " Pages output. ", vbOKOnly, "Create Notes Archive Web Pages"
0084Else
0085 Duration = Round(Duration, 2)
0086 MsgBox Now() & ": Notes Archive Webpage Creation Complete in " & Duration & " minutes. " & i & " Pages output. ", vbOKOnly, "Create Notes Archive Web Pages"
0087End If
0088End Sub

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



Source Code of: OutputNotesWebPage
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 598
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub OutputNotesWebPage(Note_ID)
0002Dim fsoTextFile As FileSystemObject
0003Dim tsTextFile As TextStream
0004Dim rsTableToRead As Recordset
0005Dim rsTableControl As Recordset
0006Dim rsFooterControl As Recordset
0007Dim rsTableControl2 As Recordset
0008Dim rsNotesLinks As Recordset
0009Dim rsNotesPreviousLinks As Recordset
0010Dim rsFNCheck As Recordset
0011Dim rsSub_Notes As Recordset
0012Dim strControlQuery As String
0013Dim strLine As String
0014Dim x As Long
0015Dim Y As String
0016Dim z As Long
0017Dim strNotesRoot As String
0018Dim strNotesRootSecure As String
0019Dim strNotesTitle_Saved As String
0020Dim iNotes_Title_Index As Integer
0021Dim Frozen_Timestamp As Long
0022Dim Duration
0023Dim DatePrint As Date
0024Dim FootNoteTimestamp As Long
0025Dim strDirectory As String
0026Dim Notes_Group_Name As String
0027Dim strNote As String
0028Dim i As Integer
0029Dim Notes_Subdirectory As String
0030Dim Temp_Note_ID
0031Dim PreviousVersionCount As Integer
0032Dim strQuery As String
0033Dim strPrefix As String
0034Dim strMulti_Prints As String
0035Dim Last_Footnote_Bulletted As String
0036Dim strLine_Break As String
0037Dim Total_Previous As Integer
0038Dim Done As String
0039Dim strColoured_Note As String
0040Dim strColour As String
0041Dim strDup_FNs As String
0042Dim Note_Text As String
0043'Read the Note
0044 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Notes_List_Auto.ID = " & Note_ID & ";"
0045Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0046'Notes_List_Auto Fields
0047'0 = ID
0048'1 = Item_Title
0049'2 = Item_Text
0050'3 = Jump_Table?
0051'4 = Note_Group
0052'5 = Master Note
0053'6 = Last_Changed
0054'7 = Private?
0055'8 = ReadingList?
0056'9 = Title?
0057'10 = Respondent?
0058'11 = Status
0059'12 = Frozen_Timestamp
0060'13 = Immediate_Promotion
0061If rsTableToRead.EOF Then
0062 MsgBox ("Note " & rsTableToRead.Fields(0) & " (" & rsTableToRead.Fields(1) & ") does not exist. ")
0063 Exit Sub
0064Else
0065 rsTableToRead.MoveFirst
0066End If
0067strNotesRoot = "C:\Theo's Files\Websites\Theo's Website\Notes\"
0068strNotesRootSecure = "C:\Theo's Files\Websites\Theo's Website\Secure_Jen\"
0069strLine = ""
0070Set fsoTextFile = Nothing
0071Set fsoTextFile = New FileSystemObject
0072'Attempt to clear the text object by updating a dummy page (otherwise if print the same note twice (without compact/repair), concatenates two sets of HTML)
0073strFolder = strNotesRoot
0074strFileName = "Dummy.htm"
0075Set tsTextFile = fsoTextFile.CreateTextFile(strFolder & strFileName, True, True)
0076strLine = "<HTML>Dummy</HTML>"
0077tsTextFile.WriteLine strLine
0078Set tsTextFile = Nothing
0079 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Notes"") And ((Website_Control.Section) = ""Text"")) ORDER BY Website_Control.Line;"
0080Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0081 Clear_Colour_Usage
0082Notes_Group_Name = rsTableToRead.Fields(4)
0083If rsTableToRead.Fields(4) = "Supervisions" Then
0084 strFolder = strNotesRootSecure
0085Else
0086 strFolder = strNotesRoot
0087End If
0088'Find the Sub-directory
0089 Notes_Subdirectory = Find_New_Directory(rsTableToRead.Fields(0))
0090Notes_Subdirectory = "Notes_" & Notes_Subdirectory & "\"
0091strFolder = strFolder & Notes_Subdirectory
0092strFileName = "Notes_" & rsTableToRead.Fields(0) & ".htm"
0093Set tsTextFile = fsoTextFile.CreateTextFile(strFolder & strFileName, True, True)
0094'Find how many previous versions
0095 strControlQuery = "SELECT Notes_Archive.Timestamp, Notes_Archive.Item_Title, Len(Notes_Archive.Item_Text), CDate([Timestamp]/1000) AS [Time Stamp], Notes.Status FROM (Notes_Archive INNER JOIN Notes_Archive_Latest_Time ON Notes_Archive.ID = Notes_Archive_Latest_Time.ID) INNER JOIN Notes ON Notes_Archive.ID = Notes.ID WHERE (((Notes_Archive.Timestamp) <> [MaxOfTimestamp]) And ((Notes_Archive.ID) = " & rsTableToRead.Fields(0) & ")) Or (((Notes_Archive.Timestamp) = [MaxOfTimestamp]) And ((Notes_Archive.ID) = " & rsTableToRead.Fields(0) & ") And ((Notes.Status) = ""Temp"")) ORDER BY Notes_Archive.Timestamp DESC;"
0096Set rsNotesPreviousLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0097PreviousVersionCount = rsNotesPreviousLinks.RecordCount
0098'Format the pages
0099rsTableControl.MoveFirst
0100Do While Not rsTableControl.EOF
0101 strLine = rsTableControl.Fields(0) & ""
0102 x = InStr(1, strLine, "**TITLE1**")
0103 If x > 0 Then
0104 If rsTableToRead.Fields(9) = True Then
0105 strLine = Left(strLine, x - 1) & "Note: " & rsTableToRead.Fields(4) & " - " & rsTableToRead.Fields(1) & " (Theo Todman's Web Page)" & Mid(strLine, x + 10, Len(strLine))
0106 Else
0107 strLine = Left(strLine, x - 1) & "Note: " & rsTableToRead.Fields(4) & " (Theo Todman's Web Page)" & Mid(strLine, x + 10, Len(strLine))
0108 End If
0109 End If
0110 x = InStr(1, strLine, "**TITLE2**")
0111 If x > 0 Then
0112 If rsTableToRead.Fields(4) = "Control" Then
0113 If rsTableToRead.Fields(9) = False Then
0114 strLine = Left(strLine, x - 1) & Mid(strLine, x + 10, Len(strLine))
0115 Else
0116 strLine = Left(strLine, x - 1) & "<h2>" & rsTableToRead.Fields(1) & Mid(strLine, x + 10, Len(strLine)) & "</h2><hr>"
0117 End If
0118 Else
0119 If rsTableToRead.Fields(9) = False Then
0120 strLine = Left(strLine, x - 1) & "<h1>Theo Todman's Web Page - Notes Pages</h1><hr><h2>" & rsTableToRead.Fields(4) & "</h2>" & Mid(strLine, x + 10, Len(strLine))
0121 Else
0122 strLine = Left(strLine, x - 1) & "<h1>Theo Todman's Web Page - Notes Pages</h1><hr><h2>" & rsTableToRead.Fields(4) & "</h2><h3>" & rsTableToRead.Fields(1) & Mid(strLine, x + 10, Len(strLine)) & "</h3>"
0123 End If
0124 End If
0125 If rsTableToRead.Fields(10) = True Then 'Respondent's Comment
0126 strLine = strLine & "<CENTER>(CORRESPONDENT'S COMMENTS)</CENTER>"
0127 Colour_Table(2, 4) = 1
0128 Else
0129 Colour_Table(1, 4) = 1
0130 End If
0131 strLine = strLine & "<p class = ""Centered"">"
0132 If (rsTableToRead.Fields(11) & "") = "Temp" Then
0133 strLine = strLine & "(Work In Progress: output at " & Now() & ")"
0134 Else
0135 strLine = strLine & "(Text as at " & CDate(rsTableToRead.Fields(6).Value / 1000) & ")"
0136 End If
0137 If PreviousVersionCount > 0 Then
0138 strLine = strLine & "<br><br>(For earlier versions of this Note, <a href=""#TableOfPreviousVersions"">see the table at the end</a>)</p>"
0139 End If
0140 If InStr(rsTableToRead.Fields(2), "|Colour_2|") > 0 Then
0141 'Advance warning for citation-text
0142 strLine = strLine & "<p>For Text Colour-conventions (at end of page): <A HREF=""#ColourConventions"">Click Here</a>.</p>"
0143 End If
0144 strLine = strLine & "<hr>"
0145 End If
0146 x = InStr(1, strLine, "**TEXT**")
0147 If x > 0 Then
0148 'Check if there are Sub_Notes, and if so refresh the Note Text from them ...
0149 strControlQuery = "SELECT * FROM SUB_Notes WHERE ID = " & Note_ID & " ORDER BY Sequence;"
0150 Set rsSub_Notes = CurrentDb.OpenRecordset(strControlQuery)
0151 If Not rsSub_Notes.EOF Then
0152 rsSub_Notes.MoveFirst
0153 Note_Text = ""
0154 'Concatenate the Notes text ...
0155 Do Until rsSub_Notes.EOF
0156 Note_Text = Note_Text & rsSub_Notes.Fields(2)
0157 rsSub_Notes.MoveNext
0158 Loop
0159 'Update the Note
0160 Set rsTableToRead = Nothing
0161 strControlQuery = "SELECT * FROM Notes WHERE ID = " & Note_ID & ";"
0162 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0163 rsTableToRead.MoveFirst
0164 rsTableToRead.Edit
0165 rsTableToRead.Fields(3) = Note_Text
0166 rsTableToRead.Update
0167 Set rsTableToRead = Nothing
0168 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Notes_List_Auto.ID = " & Note_ID & ";"
0169 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0170 rsTableToRead.MoveFirst
0171 End If
0172 Set rsSub_Notes = Nothing
0173 strLine = Left(strLine, x - 1) & IIf(rsTableToRead.Fields(10) = True, "|Colour_2|", "|Colour_1|") & rsTableToRead.Fields(2) & Mid(strLine, x + 8, Len(strLine))
0174 Frozen_Timestamp = rsTableToRead.Fields(12)
0175 Notes_Group_Name = rsTableToRead.Fields(4)
0176 OK = Notes_Text_Format(rsTableToRead.Fields(0), "N/A", strLine, Frozen_Timestamp, Notes_Group_Name) 'Use "Frozen_Timestamp" to indicate if need to timestamp the hyperlinks
0177 End If
0178 tsTextFile.WriteLine strLine
0179 rsTableControl.MoveNext
0180Loop
0181'Write out the in-page Footnotes
0182 Mark_Duplicate_Footnotes (rsTableToRead.Fields(0)) 'Flag duplicate footnotes
0183 strQuery = "SELECT Note_Footnotes.* FROM Note_Footnotes WHERE ((([Note_Footnotes]![Note_ID]) = " & rsTableToRead.Fields(0) & ")) ORDER BY Note_Footnotes!FN_ID;"
0184Set rsNotesLinks = CurrentDb.OpenRecordset(strQuery)
0185If Not rsNotesLinks.EOF Then
0186 rsNotesLinks.MoveFirst
0187 strLine = "|Colour_1|<BR><HR><h3 class = ""Left"">In-Page Footnotes:</h3>"
0188 Last_Footnote_Bulletted = "Yes"
0189 Do While Not rsNotesLinks.EOF
0190 'Format the in-page Footnotes
0191 If rsNotesLinks(1) = rsNotesLinks(4) Then 'Allow for Duplicate FNs
0192 If Last_Footnote_Bulletted = "Yes" Then
0193 strLine_Break = ""
0194 Else
0195 strLine_Break = "<BR><BR>"
0196 End If
0197 If InStr(Right(Trim(rsNotesLinks.Fields(2).Value), 4), "|") > 0 Then 'Determine if the footnote ends in a bulleted list. If so, don't add line breaks next time ...
0198 Last_Footnote_Bulletted = "Yes"
0199 Else
0200 Last_Footnote_Bulletted = "No"
0201 End If
0202 'Check, and list, Duplicate FNs
0203 strDup_FNs = ""
0204 Set rsFNCheck = CurrentDb.OpenRecordset("SELECT Note_Footnotes.Note_ID, Note_Footnotes.FN_ID, Note_Footnotes.Master_ID FROM Note_Footnotes WHERE (((Note_Footnotes.Note_ID) = " & Note_ID & ") And ((Note_Footnotes.FN_ID) <> [Note_Footnotes]![Master_ID]) And ((Note_Footnotes.Master_ID) = " & rsNotesLinks(1) & ")) ORDER BY Note_Footnotes.FN_ID;")
0205 If Not rsFNCheck.EOF Then
0206 rsFNCheck.MoveFirst
0207 Do While Not rsFNCheck.EOF
0208 strDup_FNs = strDup_FNs & "<A HREF=""#On-Page_Return_" & rsTableToRead.Fields(0) & "_" & rsFNCheck.Fields(1).Value & """>, " & rsFNCheck.Fields(1).Value & "</A>"
0209 rsFNCheck.MoveNext
0210 Loop
0211 End If
0212 Set rsFNCheck = Nothing
0213 strLine = strLine & "<a name=""On-Page_Link_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(1).Value & """></A>" & strLine_Break & "<U><A HREF=""#On-Page_Return_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(1).Value & """>" & "<B>Footnote" & IIf(strDup_FNs = "", " ", "s ") & rsNotesLinks.Fields(1).Value & "</A>" & strDup_FNs & "</B></U>: " & rsNotesLinks.Fields(2).Value
0214 End If
0215 rsNotesLinks.MoveNext
0216 Loop
0217 strLine = strLine & "</center><br>"
0218 strLine = Remove_Dummy_Ref(strLine)
0219 strLine = WebEncode(strLine)
0220 strLine = ImageRef(strLine, "Notes", "N", Note_ID, 0)
0221 OK = Reference_Books(strLine, "N", Note_ID, 0)
0222 OK = Reference_Author(strLine, "N", Note_ID, 0) 'Replace the Author References by hyperlinks
0223 OK = Reference_Note_Links(strLine, "N", Note_ID, 0) 'Replace the Note_Link References by hyperlinks
0224 OK = Reference_Reference(strLine)
0225 OK = Reference_Papers(strLine, "N", Note_ID, 0)
0226 OK = Reference_Notes(strLine, "N", Note_ID, 0)
0227 OK = Reference_Code(strLine)
0228 OK = Reference_Code_Bridge(strLine)
0229 OK = Reference_Tables(strLine) 'Replace Table-references by hyperlinks
0230 OK = Reference_Queries(strLine) 'Replace Query-references by hyperlinks
0231 OK = Reference_Webrefs(strLine, "N", Note_ID, 0)
0232 strLine = NumberedBullets(strLine)
0233 strLine = Bullets(strLine)
0234 OK = Mark_Colours(strLine)
0235 OK = Classification_Change(strLine)
0236 tsTextFile.WriteLine strLine
0237End If
0238Set rsNotesLinks = Nothing
0239'Output the links to printable versions
0240If InStr(rsTableToRead.Fields(2), "<B>Printable Version</B>:") = 0 And InStr(rsTableToRead.Fields(2), "<B>Printable Versions</B>:") = 0 Then 'ie. not already a manually-created link to printable versions
0241 strControlQuery = "Select Notes_To_Print.* FROM Notes_To_Print WHERE (Notes_To_Print.Note_ID = " & rsTableToRead.Fields(0) & " AND Notes_To_Print.Current=True) ORDER BY Notes_To_Print.Max_Depth;"
0242 Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0243 If Not rsNotesLinks.EOF Then
0244 strPrefix = ""
0245 rsNotesLinks.MoveFirst
0246 strLine = "<br><hr><h3 class = ""Left"">Printable Version:</h3> <UL><li>Follow "
0247 strMulti_Prints = "No"
0248 Do While Not rsNotesLinks.EOF
0249 'Write out each link in one bulletted string
0250 'But print the Note
0251 strPrintDuplicateFootnoteRefs = rsNotesLinks.Fields(4) & ""
0252 strPrintReadingLists = rsNotesLinks.Fields(3) & ""
0253 OK = NoteForPrinting(rsTableToRead.Fields(0), rsNotesLinks.Fields(1), rsNotesLinks.Fields(2), IIf(Notes_Group_Name = "Supervisions", 10, 0), Last_Changed_Timestamp, "")
0254 strLine = strLine & strPrefix & "(<A Href=""Notes_Print/NotesPrint_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(1) & IIf(rsNotesLinks.Fields(2) & "" = "Yes", "_P", "") & IIf(strPrintReadingLists = "Yes", "_R", "") & IIf(strPrintDuplicateFootnoteRefs = "Yes", "_D", "") & ".htm"" TARGET = ""_top"">this link</A>) for level " & rsNotesLinks.Fields(1).Value & IIf(strPrintReadingLists = "Yes", IIf(strPrintDuplicateFootnoteRefs = "Yes", " (with reading list and duplicate footnotes indicated)", " (with reading list)"), IIf(strPrintDuplicateFootnoteRefs = "Yes", " (with duplicate footnotes indicated)", ""))
0255 rsNotesLinks.MoveNext
0256 If rsNotesLinks.EOF Then
0257 strPrefix = ""
0258 Else
0259 strPrefix = ", and </li><li>Follow "
0260 strMulti_Prints = "Yes"
0261 End If
0262 Loop
0263 strLine = strLine & ".</li></UL>"
0264 If strMulti_Prints = "Yes" Then
0265 strLine = ReplaceCode(strLine, "Printable Version", "Printable Versions")
0266 End If
0267 tsTextFile.WriteLine strLine
0268 End If
0269End If
0270'Table of previous versions
0271Total_Previous = 0
0272If PreviousVersionCount > 12 Then
0273 Total_Previous = PreviousVersionCount
0274 PreviousVersionCount = 12
0275End If
0276If Not rsNotesPreviousLinks.EOF Then
0277 If PreviousVersionCount > 1 Then
0278 strLine = "<BR><HR><h3 class= ""Left"">Table of the Previous " & PreviousVersionCount & " Versions of this Note:" & IIf(Total_Previous = 0, "", " (of " & Total_Previous & ")") & "</h3>"
0279 Else
0280 strLine = "<BR><HR><h3 class= ""Left"">Previous Version of this Note:</h3>"
0281 End If
0282 strLine = "<a name=""TableOfPreviousVersions""></a>" & strLine
0283 tsTextFile.WriteLine strLine
0284 strLine = "<TABLE class = ""ReadingList"" WIDTH=700>"
0285 tsTextFile.WriteLine strLine
0286 strLine = "<TR><TD WIDTH=""20%"" class = ""BridgeCenter""><strong>Date</strong></TD>"
0287 tsTextFile.WriteLine strLine
0288 strLine = "<TD WIDTH=""10%"" class = ""BridgeRight""><strong>Length</strong></TD>"
0289 tsTextFile.WriteLine strLine
0290 strLine = "<TD WIDTH=""70%"" class = ""BridgeLeft""><strong>Title</strong></TD></TR>"
0291 tsTextFile.WriteLine strLine
0292 rsNotesPreviousLinks.MoveFirst
0293 Do While Not (rsNotesPreviousLinks.EOF Or PreviousVersionCount < 1)
0294 PreviousVersionCount = PreviousVersionCount - 1
0295 strLine = "<TR><TD class = ""BridgeCenter"">" & rsNotesPreviousLinks.Fields(3).Value & "</TD>"
0296 tsTextFile.WriteLine strLine
0297 strLine = "<TD class = ""BridgeRight"">" & rsNotesPreviousLinks.Fields(2).Value & "</TD>"
0298 tsTextFile.WriteLine strLine
0299 strLine = "<TD class = ""BridgeLeft""><A HREF = ""Notes_" & rsTableToRead.Fields(0) & "_" & rsNotesPreviousLinks.Fields(0).Value & ".htm"">" & rsNotesPreviousLinks.Fields(1).Value & "</A>" & "</TD></TR>"
0300 tsTextFile.WriteLine strLine
0301 rsNotesPreviousLinks.MoveNext
0302 Loop
0303 strLine = "</TABLE>"
0304 tsTextFile.WriteLine strLine
0305End If
0306Set rsNotesPreviousLinks = Nothing
0307If Note_ID <> 874 Then 'N/A for Test Note
0308 'Footer Table & Headers
0309 strLine = "<BR><HR><BR><CENTER><TABLE class = ""Bridge"" WIDTH=950><TR>"
0310 tsTextFile.WriteLine strLine
0311 strLine = "<TH WIDTH=""25%"">Note last updated</TH>"
0312 tsTextFile.WriteLine strLine
0313 If rsTableToRead.Fields(8).Value = "Yes" Then
0314 strLine = "<TH WIDTH=""50%"">Reading List for this Topic</TH>"
0315 tsTextFile.WriteLine strLine
0316 Else
0317 strLine = "<TH WIDTH=""50%"">Reference for this Topic</TH>"
0318 tsTextFile.WriteLine strLine
0319 End If
0320 strLine = "<TH WIDTH=""25%"">Parent Topic</TH></TR>"
0321 tsTextFile.WriteLine strLine
0322 'Last updated Footer
0323 If (rsTableToRead.Fields(11) & "") = "Temp" Then
0324 DatePrint = Now()
0325 Else
0326 DatePrint = Val(rsTableToRead.Fields(6) & "") / 1000
0327 End If
0328 strLine = "<TR><TD WIDTH=""25%"">" & DatePrint & "</TD>"
0329 tsTextFile.WriteLine strLine
0330 'Reading-List Footer
0331 If rsTableToRead.Fields(8).Value = "Yes" Then
0332 strControlQuery = "SELECT [Identity Papers - Abstracts - Full - SubTopic (Titles)].ID, [Identity Papers - Abstracts - Full - SubTopic (Titles)].[Sub-Topic] FROM Notes INNER JOIN [Identity Papers - Abstracts - Full - SubTopic (Titles)] ON Notes.Item_Title = [Identity Papers - Abstracts - Full - SubTopic (Titles)].[Sub-Topic] WHERE (((Notes.ID)=" & rsTableToRead.Fields(0) & "));"
0333 Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0334 If Not rsNotesLinks.EOF Then
0335 rsNotesLinks.MoveFirst
0336 strLine = "<A HREF = ""../../PaperCatalogIdentityFullSubTopic_" & rsNotesLinks.Fields(0) & ".htm"" TARGET = ""_top"">" & rsTableToRead.Fields(1) & "</A>"
0337 strLine = "<TD WIDTH=""50%"">" & strLine & "</TD>"
0338 Else
0339 strLine = "<TD WIDTH=""50%"">None available</TD>"
0340 End If
0341 tsTextFile.WriteLine strLine
0342 Else
0343 strLine = "<TD WIDTH=""50%"">" & rsTableToRead.Fields(0).Value & " (" & rsTableToRead.Fields(1).Value & ")</TD>"
0344 tsTextFile.WriteLine strLine
0345 End If
0346 'Parent Topic Footer
0347 strLine = "<TD WIDTH=""25%"">" & rsTableToRead.Fields(5) & "</TD></TR>"
0348 tsTextFile.WriteLine strLine
0349 strLine = "</TABLE></center>"
0350 tsTextFile.WriteLine strLine
0351End If
0352'Links Out Footer
0353strNotesTitle_Saved = ""
0354iNotes_Title_Index = 1
0355 strControlQuery = "SELECT Cross_Reference.Called_ID, 0 AS Called_Ref, Notes.Item_Title, Notes_1.Note_Group, Notes.Note_Group, Note_Qualities.Note_Quality_Text, Note_Qualities.Note_Quality_Colour FROM ((Cross_Reference INNER JOIN Notes ON Cross_Reference.Called_ID = Notes.ID) INNER JOIN Notes AS Notes_1 ON Cross_Reference.Calling_ID = Notes_1.ID) LEFT JOIN Note_Qualities ON Notes.Note_Quality = Note_Qualities.Note_Quality WHERE (((Cross_Reference.Calling_ID) = " & rsTableToRead.Fields(0) & ") And ((Cross_Reference.Calling_Type) = ""N"") And ((Cross_Reference.Called_Type) = ""N"") And ((Cross_Reference.Calling_Timestamp) = 0) And ((Cross_Reference.Called_Timestamp) = 0)) GROUP BY Cross_Reference.Called_ID, 0, Notes.Item_Title, Notes_1.Note_Group, Notes.Note_Group, Note_Qualities.Note_Quality_Text, Note_Qualities.Note_Quality_Colour ORDER BY Notes.Item_Title;"
0356Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0357If Not rsNotesLinks.EOF Then
0358 strLine = "<hr><h3>Summary of Note Links from this Page</h3>"
0359 tsTextFile.WriteLine strLine
0360 'Title-based jump table
0361 ' ... Header
0362 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table_Titles"") And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0363 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0364 rsTableControl2.MoveFirst
0365 Do While Not rsTableControl2.EOF
0366 strLine = rsTableControl2.Fields(0) & ""
0367 tsTextFile.WriteLine strLine
0368 rsTableControl2.MoveNext
0369 Loop
0370 ' ... Rows
0371 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table_Titles"") And ((Website_Control.Section) = ""Rows"")) ORDER BY Website_Control.Line;"
0372 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0373 rsTableControl2.MoveFirst
0374 rsNotesLinks.MoveFirst
0375 Do While (Not rsTableControl2.EOF Or Not rsNotesLinks.EOF)
0376 If rsTableControl2.EOF Then
0377 rsTableControl2.MoveFirst
0378 End If
0379 strLine = rsTableControl2.Fields(0) & ""
0380 x = InStr(1, strLine, "**Column")
0381 If x > 0 Then
0382 z = 0
0383 If Not rsNotesLinks.EOF Then
0384 If rsNotesLinks.Fields(2) = strNotesTitle_Saved Then
0385 iNotes_Title_Index = iNotes_Title_Index + 1
0386 Else
0387 iNotes_Title_Index = 1
0388 strNotesTitle_Saved = rsNotesLinks.Fields(2)
0389 End If
0390 'Find latest Timestamp for links
0391 FootNoteTimestamp = 0
0392 'Determine if across secure area
0393 strDirectory = ""
0394 If rsNotesLinks.Fields(4) <> 10 Then
0395 strDirectory = "../../Notes/"
0396 Else
0397 strDirectory = "../../Secure_Jen/"
0398 End If
0399 strColoured_Note = rsNotesLinks.Fields(2)
0400 strColour = rsNotesLinks.Fields(6) & ""
0401 If strColour <> "" Then
0402 strColour = " bgcolor=""#" & strColour & """"
0403 z = Len(strColour)
0404 strLine = Replace(strLine, "<td", "<td" & strColour)
0405 strColoured_Note = "<span title=""" & rsNotesLinks.Fields(5) & """>" & strColoured_Note & "</span>" 'Need to add pop-up
0406 End If
0407 Y = "<A href = """ & strDirectory & "Notes_" & Find_New_Directory(rsNotesLinks.Fields(0).Value) & "/Notes_" & rsNotesLinks.Fields(0) & IIf(FootNoteTimestamp > 0, "_" & FootNoteTimestamp, "") & ".htm" & IIf(rsNotesLinks.Fields(1) <> 0, "#" & rsNotesLinks.Fields(1), "") & """>" & strColoured_Note & IIf(iNotes_Title_Index > 1, " (" & iNotes_Title_Index & ")", "") & "</A>"
0408 Else
0409 Y = "&nbsp;"
0410 End If
0411 strLine = Left(strLine, x + z - 1) & Y & Mid(strLine, x + z + 10, Len(strLine))
0412 If Not rsNotesLinks.EOF Then
0413 rsNotesLinks.MoveNext
0414 End If
0415 tsTextFile.WriteLine strLine
0416 Else
0417 tsTextFile.WriteLine strLine
0418 End If
0419 rsTableControl2.MoveNext
0420 Loop
0421 ' ... Footer
0422 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table_Titles"") And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0423 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0424 rsTableControl2.MoveFirst
0425 Do While Not rsTableControl2.EOF
0426 strLine = rsTableControl2.Fields(0) & ""
0427 tsTextFile.WriteLine Replace(strLine, " (if any)", "")
0428 rsTableControl2.MoveNext
0429 Loop
0430End If
0431If Note_ID <> 874 Then 'N/A for Test Note
0432 'Notes Links In Footer
0433 strNotesTitle_Saved = ""
0434 iNotes_Title_Index = 1
0435 strControlQuery = "SELECT Cross_Reference.Calling_ID, Cross_Reference.Calling_NameRef, Notes.Item_Title, Notes.Note_Group, Notes_1.Note_Group, Note_Qualities.Note_Quality_Text, Note_Qualities.Note_Quality_Colour FROM ((Cross_Reference INNER JOIN Notes ON Cross_Reference.Calling_ID = Notes.ID) INNER JOIN Notes AS Notes_1 ON Cross_Reference.Called_ID = Notes_1.ID) LEFT JOIN Note_Qualities ON Notes.Note_Quality = Note_Qualities.Note_Quality WHERE (((Cross_Reference.Called_ID) = " & rsTableToRead.Fields(0) & ") And ((Cross_Reference.Calling_Type) = ""N"") And ((Cross_Reference.Called_Type) = ""N"") And ((Cross_Reference.Calling_Timestamp) = 0) And ((Cross_Reference.Called_Timestamp) = 0)) ORDER BY Notes.Item_Title, Cross_Reference.Calling_NameRef;"
0436 Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0437 If Not rsNotesLinks.EOF Then
0438 strLine = "<BR><HR><BR><h3>Summary of Note Links to this Page</h3>"
0439 tsTextFile.WriteLine strLine
0440 'Title-based jump table
0441 ' ... Header
0442 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table_Titles"") And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0443 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0444 rsTableControl2.MoveFirst
0445 Do While Not rsTableControl2.EOF
0446 strLine = rsTableControl2.Fields(0) & ""
0447 tsTextFile.WriteLine strLine
0448 rsTableControl2.MoveNext
0449 Loop
0450 ' ... Rows
0451 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table_Titles"") And ((Website_Control.Section) = ""Rows"")) ORDER BY Website_Control.Line;"
0452 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0453 rsTableControl2.MoveFirst
0454 rsNotesLinks.MoveFirst
0455 Do While (Not rsTableControl2.EOF Or Not rsNotesLinks.EOF)
0456 If rsTableControl2.EOF Then
0457 rsTableControl2.MoveFirst
0458 End If
0459 strLine = rsTableControl2.Fields(0) & ""
0460 x = InStr(1, strLine, "**Column")
0461 If x > 0 Then
0462 z = 0
0463 iNotes_Title_Index = 1
0464 If Not rsNotesLinks.EOF Then
0465 'Determine if across secure area
0466 strDirectory = ""
0467 If rsNotesLinks.Fields(3) <> 10 Then
0468 strDirectory = "../../Notes/"
0469 Else
0470 strDirectory = "../../Secure_Jen/"
0471 End If
0472 strColoured_Note = rsNotesLinks.Fields(2)
0473 strColour = rsNotesLinks.Fields(6) & ""
0474 If strColour <> "" Then
0475 strColour = " bgcolor=""#" & strColour & """"
0476 z = Len(strColour)
0477 strLine = Replace(strLine, "<td", "<td" & strColour)
0478 strColoured_Note = "<span title=""" & rsNotesLinks.Fields(5) & """>" & strColoured_Note & "</span>" 'Need to add pop-up
0479 End If
0480 Y = "<A href = """ & strDirectory & "Notes_" & Find_New_Directory(rsNotesLinks.Fields(0).Value) & "/Notes_" & rsNotesLinks.Fields(0) & IIf(FootNoteTimestamp > 0, "_" & FootNoteTimestamp, "") & ".htm" & IIf(rsNotesLinks.Fields(1) <> 0, "#" & rsNotesLinks.Fields(1), "") & """>" & strColoured_Note & IIf(iNotes_Title_Index > 1, " (" & iNotes_Title_Index & ")", "") & "</A>"
0481 'Repeat citings
0482 strNotesTitle_Saved = rsNotesLinks.Fields(2)
0483 Done = "No"
0484 i = 1
0485 Do Until Done = "Yes"
0486 rsNotesLinks.MoveNext
0487 If rsNotesLinks.EOF Then
0488 rsNotesLinks.MovePrevious
0489 Done = "Yes"
0490 Else
0491 If (strNotesTitle_Saved = rsNotesLinks.Fields(2).Value) Then
0492 iNotes_Title_Index = iNotes_Title_Index + 1
0493 i = i + 1
0494 If Y <> "" Then
0495 Y = Y & ", "
0496 End If
0497 'Determine if across secure area
0498 strDirectory = ""
0499 If rsNotesLinks.Fields(3) <> 10 Then
0500 strDirectory = "../../Notes/"
0501 Else
0502 strDirectory = "../../Secure_Jen/"
0503 End If
0504 Y = Y & "<A href = """ & strDirectory & "Notes_" & Find_New_Directory(rsNotesLinks.Fields(0).Value) & "/Notes_" & rsNotesLinks.Fields(0) & IIf(FootNoteTimestamp > 0, "_" & FootNoteTimestamp, "") & ".htm" & IIf(rsNotesLinks.Fields(1) <> 0, "#" & rsNotesLinks.Fields(1), "") & """>" & IIf(iNotes_Title_Index > 1, iNotes_Title_Index, "") & "</A>"
0505 Else
0506 rsNotesLinks.MovePrevious
0507 Done = "Yes"
0508 End If
0509 End If
0510 Loop
0511 FootNoteTimestamp = 0
0512 Else
0513 Y = "&nbsp;"
0514 End If
0515 strLine = Left(strLine, x + z - 1) & Y & Mid(strLine, x + z + 10, Len(strLine))
0516 If Not rsNotesLinks.EOF Then
0517 rsNotesLinks.MoveNext
0518 End If
0519 tsTextFile.WriteLine strLine
0520 Else
0521 tsTextFile.WriteLine strLine
0522 End If
0523 rsTableControl2.MoveNext
0524 Loop
0525 ' ... Footer
0526 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table_Titles"") And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0527 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0528 rsTableControl2.MoveFirst
0529 Do While Not rsTableControl2.EOF
0530 strLine = rsTableControl2.Fields(0) & ""
0531 tsTextFile.WriteLine Replace(strLine, " (if any)", "")
0532 rsTableControl2.MoveNext
0533 Loop
0534 End If
0535 'Add the list of Authors, Books & Papers referencing this Note
0536 OK = AddCitations_List("Note", rsTableToRead.Fields(0), tsTextFile, "Non-Print")
0537 'Add the Reading List - note - need to populate Note_Usage_Temp first
0538 ' ... Only if this Notes_Group has Reading Lists ...
0539 strLine = "Select Note_Groups![ReadingList?] From Note_Groups Where Note_Groups.Note_Group = """ & rsTableToRead.Fields(4) & """;"
0540 Set rsTableControl2 = CurrentDb.OpenRecordset(strLine)
0541 rsTableControl2.MoveFirst
0542 If rsTableControl2.Fields(0).Value = "Yes" Then
0543 'Clear the Notes usage table
0544 DoCmd.RunSQL ("DELETE Note_Usage_Temp.* FROM Note_Usage_Temp;")
0545 'Prepopulate with the main note
0546 strLine = "SELECT Note_Usage_Temp.* FROM Note_Usage_Temp;"
0547 Set rsTableControl2 = CurrentDb.OpenRecordset(strLine)
0548 rsTableControl2.AddNew
0549 rsTableControl2.Fields(0) = rsTableToRead.Fields(0)
0550 rsTableControl2.Fields(1) = "Main Text"
0551 rsTableControl2.Fields(2) = 0
0552 rsTableControl2.Fields(3) = 0
0553 rsTableControl2.Fields(4) = 0
0554 rsTableControl2.Update
0555 OK = AddReading_List(rsTableToRead.Fields(1), tsTextFile, "Non-Print")
0556 End If
0557 'Add Colour Conventions list
0558 strLine = "<a name=""ColourConventions""></a><br><hr><br><h3 class = ""Left"">Text Colour Conventions</h3><OL TYPE=""1"">"
0559 For i = 0 To 19
0560 If Colour_Table(i, 4) = "1" Then
0561 strLine = strLine & "<li><FONT COLOR = """ & Colour_Table(i, 1) & """>" & Colour_Table(i, 2) & "</FONT>: " & Colour_Table(i, 3) & "</li>"
0562 End If
0563 Next i
0564 strLine = strLine & "</OL><BR>"
0565 tsTextFile.WriteLine strLine
0566End If
0567'Note-page Footer
0568strLine = ""
0569 strControlTable = "Notes"
0570 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0571Set rsFooterControl = CurrentDb.OpenRecordset(strControlQuery)
0572rsFooterControl.MoveFirst
0573Do While Not rsFooterControl.EOF
0574 strLine = strLine & rsFooterControl.Fields(0)
0575 OK = Replace_Timestamp(strLine)
0576 rsFooterControl.MoveNext
0577Loop
0578tsTextFile.WriteLine strLine
0579'Copy to Transfer
0580If (rsTableToRead.Fields(11) & "" <> "Temp") Or ((rsTableToRead.Fields(11) & "" = "Temp") And (rsTableToRead.Fields(13) = True)) Then
0581 If rsTableToRead.Fields(7).Value = "Yes" Then
0582 OK = CopyToTransfer(strFolder, strFileName, "Private")
0583 Else
0584 OK = CopyToTransfer(strFolder, strFileName)
0585 End If
0586End If
0587'Have we just archived this Note? Then we'll need to create its timestamped page
0588If rsTableToRead.Fields(6).Value = Last_Changed_Timestamp Then
0589 If (rsTableToRead.Fields(11) & "") <> "Temp" Then 'Ignore "Immediate promotion" Temp Notes
0590 OK = OutputNotesWebPage_Archived(rsTableToRead.Fields(0))
0591 End If
0592End If
0593'Tidy Up
0594Set rsNotesLinks = Nothing
0595Set rsTableControl = Nothing
0596Set rsTableToRead = Nothing
0597Set fsoTextFile = Nothing
0598End Sub

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



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