| 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 |