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