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