THEO TODMAN’S WEBSITE CODE PAGES


This Page provides a jumping-off point for the VBA Code that generates my Website.

Table of Code Documentation Location 34 (1 items)

OutputNotesWebPage_Archived...

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

Go to top of page



Source Code of: OutputNotesWebPage_Archived
Procedure Type: Public Function
Module: General_Subroutines
Lines of Code: 738
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function OutputNotesWebPage_Archived(Note_ID, Optional Archive_Timestamp)
0002Dim fsoTextFile As FileSystemObject
0003Dim tsTextFile_Archive As TextStream
0004Dim tsTextFile As TextStream
0005Dim rsTableToRead As Recordset
0006Dim rsTableControl As Recordset
0007Dim rsFooterControl As Recordset
0008Dim rsTableControl2 As Recordset
0009Dim rsNotesLinks As Recordset
0010Dim rsFNCheck As Recordset
0011Dim strControlQuery As String
0012Dim strLine_Archive As String
0013Dim x As Long
0014Dim x1 As Long
0015Dim Y As String
0016Dim z1 As Long
0017Dim strNotesRoot As String
0018Dim strNotesRootSecure As String
0019Dim strNotesTitle_Saved As String
0020Dim iNotes_Title_Index As Integer
0021Dim Frozen_Timestamp As Long
0022Dim Duration
0023Dim DatePrint As Date
0024Dim strFilename_Archived As String
0025Dim FootNoteTimestamp As Long
0026Dim FootNoteTimestamp_Saved As Long
0027Dim strDirectory As String
0028Dim Notes_Group_Name As String
0029Dim strSearch As String
0030Dim strNote As String
0031Dim i As Integer
0032Dim Notes_Subdirectory As String
0033Dim Temp_Note_ID
0034Dim PreviousVersionCount As Integer
0035Dim strQuery As String
0036Dim strPrefix As String
0037Dim strMulti_Prints As String
0038Dim Last_Footnote_Bulletted As String
0039Dim strLine_Break As String
0040Dim As_At_Text As String
0041Dim Latest_Version_Timestamp As Long
0042Dim Link_Title As String
0043Dim Link_Title_Saved As String
0044Dim Link_Title_Output As String
0045Dim Link_Title_Output_Saved As String
0046Dim Print_Cell As Boolean
0047Dim Total_Previous As Integer
0048Dim strDup_FNs As String
0049Dim Link_ID As Integer
0050Dim Link_ID_Saved As Integer
0051Dim NameRef As String
0052Dim sw As StopWatch
0053Dim sw2 As StopWatch
0054'Test_Flag = True
0055If Test_Flag = True Then
0056 Set sw = New StopWatch
0057 Set sw2 = New StopWatch
0058 sw.StartTimer
0059End If
0060If Test_Flag = True Then
0061 sw2.StartTimer
0062End If
0063'Read the Note
0064If IsMissing(Archive_Timestamp) Then
0065 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto WHERE Notes_List_Auto.ID = " & Note_ID & ";"
0066 Archive_Timestamp = Last_Changed_Timestamp
0067Else
0068 Last_Changed_Timestamp = Archive_Timestamp
0069 strControlQuery = "SELECT Notes_Archive_List_Auto.* FROM Notes_Archive_List_Auto WHERE Notes_Archive_List_Auto.ID = " & Note_ID & " AND Notes_Archive_List_Auto.[Timestamp]=" & Archive_Timestamp & ";"
0070End If
0071Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0072'Notes_List_Auto Fields
0073'0 = ID
0074'1 = Item_Title
0075'2 = Item_Text
0076'3 = Jump_Table?
0077'4 = Note_Group
0078'5 = Master Note
0079'6 = Last_Changed
0080'7 = Private?
0081'8 = ReadingList?
0082'9 = Title?
0083'10 = Respondent?
0084'11 = Status
0085'12 = Frozen_Timestamp
0086'13 = Immediate_Promotion
0087'14 = Note_Quality
0088'15 = Temp_Note_Timestamp
0089If rsTableToRead.EOF Then
0090 MsgBox ("Note " & Note_ID & IIf(IsMissing(Archive_Timestamp), "", " (ID " & Archive_Timestamp & ")") & " does not exist. ")
0091 Exit Function
0092Else
0093 rsTableToRead.MoveFirst
0094End If
0095strNotesRoot = TheoWebsiteRoot & "\Notes\"
0096strNotesRootSecure = TheoWebsiteRoot & "\Secure_Jen\"
0097strLine_Archive = ""
0098Set fsoTextFile = Nothing
0099Set fsoTextFile = New FileSystemObject
0100'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)
0101strFolder = strNotesRoot
0102strFilename_Archived = "Dummy.htm"
0103Set tsTextFile_Archive = fsoTextFile.CreateTextFile(strFolder & strFilename_Archived, True, True)
0104strLine_Archive = "<HTML>Dummy</HTML>"
0105tsTextFile_Archive.WriteLine strLine_Archive
0106Set tsTextFile_Archive = Nothing
0107 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;"
0108Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0109 Clear_Colour_Usage
0110Notes_Group_Name = rsTableToRead.Fields(4)
0111If rsTableToRead.Fields(4) = "Supervisions" Then
0112 strFolder = strNotesRootSecure
0113Else
0114 strFolder = strNotesRoot
0115End If
0116'Find the Sub-directory
0117 Notes_Subdirectory = Find_New_Directory(rsTableToRead.Fields(0))
0118Notes_Subdirectory = "Notes_" & Notes_Subdirectory & "\"
0119strFolder = strFolder & Notes_Subdirectory
0120strFilename_Archived = "Notes_" & rsTableToRead.Fields(0) & "_" & Last_Changed_Timestamp & ".htm"
0121Set tsTextFile_Archive = fsoTextFile.CreateTextFile(strFolder & strFilename_Archived, True, True)
0122If Test_Flag = True Then
0123 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Set-up complete"
0124End If
0125'Format the page
0126If Test_Flag = True Then
0127 sw2.StartTimer
0128End If
0129rsTableControl.MoveFirst
0130Do While Not rsTableControl.EOF
0131 strLine_Archive = rsTableControl.Fields(0) & ""
0132 x = InStr(1, strLine_Archive, "**TITLE1**")
0133 If x > 0 Then
0134 If rsTableToRead.Fields(9) = True Then
0135 strLine_Archive = Left(strLine_Archive, x - 1) & "Note: " & rsTableToRead.Fields(4) & " - " & rsTableToRead.Fields(1) & " (Theo Todman's Web Page)" & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0136 Else
0137 strLine_Archive = Left(strLine_Archive, x - 1) & "Note: " & rsTableToRead.Fields(4) & " (Theo Todman's Web Page)" & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0138 End If
0139 End If
0140 x = InStr(1, strLine_Archive, "**TITLE2**")
0141 If x > 0 Then
0142 As_At_Text = "<p class = ""Centered"">(Text as at " & CDate(Last_Changed_Timestamp / 1000) & ")"
0143 If rsTableToRead.Fields(4) = "Control" Then
0144 If rsTableToRead.Fields(9) = False Then
0145 strLine_Archive = Left(strLine_Archive, x - 1) & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0146 Else
0147 strLine_Archive = Left(strLine_Archive, x - 1) & "<h2>" & rsTableToRead.Fields(1) & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive)) & "</h2>"
0148 End If
0149 Else
0150 If rsTableToRead.Fields(9) = False Then
0151 strLine_Archive = Left(strLine_Archive, x - 1) & "<h1>Theo Todman's Web Page - Notes Pages</h1><hr><h2>" & rsTableToRead.Fields(4) & "</h2>" & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0152 Else
0153 strLine_Archive = Left(strLine_Archive, x - 1) & "<h1>Theo Todman's Web Page - Notes Pages</h1><hr><h2>" & rsTableToRead.Fields(4) & "</h2><h3>" & rsTableToRead.Fields(1) & "</h3>" & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0154 End If
0155 End If
0156 strLine_Archive = strLine_Archive & "<br><br><b><FONT COLOR = ""FF0000""><h2>*** THIS IS NOT THE LATEST VERSION OF THIS NOTE ***</h2></FONT></b>"
0157 strLine_Archive = strLine_Archive & "<br><CENTER>(For the live version and other versions of this Note, see the <a href=""#LiveVersion"">tables at the end</a>)<br><br></CENTER>"
0158 If rsTableToRead.Fields(10) = True Then 'Respondent's Comment
0159 strLine_Archive = strLine_Archive & "<CENTER>(CORRESPONDENT'S COMMENTS)</CENTER>"
0160 Colour_Table(2, 4) = 1
0161 Else
0162 Colour_Table(1, 4) = 1
0163 End If
0164 If InStr(rsTableToRead.Fields(2), "|Colour_2|") > 0 Then
0165 'Advance warning for citation-text
0166 strLine_Archive = strLine_Archive & "<p>For Text Colour-conventions (at end of page): <A HREF=""#ColourConventions"">Click Here</a>.</p><hr>"
0167 Else
0168 strLine_Archive = strLine_Archive & "<hr>"
0169 End If
0170 End If
0171 x = InStr(1, strLine_Archive, "**TEXT**")
0172 If x > 0 Then
0173 If Test_Flag = True Then
0174 sw2.StartTimer
0175 End If
0176 Frozen_Timestamp = rsTableToRead.Fields(12)
0177 Notes_Group_Name = rsTableToRead.Fields(4)
0178 'Adjust for embedded Notes_Print links
0179 'Determine the Note-Print String
0180 strSearch = "Notes_Print/NotesPrint_" & rsTableToRead.Fields(0)
0181 strNote = rsTableToRead.Fields(2)
0182 x1 = InStr(strNote, strSearch)
0183 If x1 > 0 Then
0184 z1 = InStr(x1, strNote, ".htm")
0185 If z1 > 0 Then
0186 'Add the timestamp to the Notes-Print link
0187 strNote = Left(strNote, z1 - 1) & "_" & Last_Changed_Timestamp & Mid(strNote, z1, Len(strNote))
0188 'Add to the Notes_Print_Archive table
0189 strControlQuery = "SELECT Note_Print_Links.Note_ID, Note_Print_Links.Timestamp FROM Note_Print_Links WHERE (((Note_Print_Links.Note_ID)=" & rsTableToRead.Fields(0) & ") AND ((Note_Print_Links.Timestamp)=" & Last_Changed_Timestamp & "));"
0190 Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0191 If rsNotesLinks.EOF Then
0192 rsNotesLinks.AddNew
0193 rsNotesLinks.Fields(0) = rsTableToRead.Fields(0)
0194 rsNotesLinks.Fields(1) = Last_Changed_Timestamp
0195 rsNotesLinks.Update
0196 End If
0197 Set rsNotesLinks = Nothing
0198 End If
0199 End If
0200 strLine_Archive = Left(strLine_Archive, x - 1) & IIf(rsTableToRead.Fields(10) = True, "|Colour_2|", "|Colour_1|") & strNote & Mid(strLine_Archive, x + 8, Len(strLine_Archive))
0201 OK = Notes_Text_Format(rsTableToRead.Fields(0), "N/A", strLine_Archive, Last_Changed_Timestamp, Notes_Group_Name)
0202 If Test_Flag = True Then
0203 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Page Text Formatted"
0204 sw2.StartTimer
0205 End If
0206 End If
0207 tsTextFile_Archive.WriteLine strLine_Archive
0208 rsTableControl.MoveNext
0209Loop
0210'Write out the in-page Footnotes
0211 strQuery = "SELECT Note_Footnotes.* FROM Note_Footnotes WHERE ((([Note_Footnotes]![Note_ID]) = " & rsTableToRead.Fields(0) & ")) ORDER BY Note_Footnotes!FN_ID;"
0212Set rsNotesLinks = CurrentDb.OpenRecordset(strQuery)
0213If Not rsNotesLinks.EOF Then
0214 rsNotesLinks.MoveFirst
0215 strLine_Archive = "|Colour_1|<BR><HR><h3 class = ""Left"">In-Page Footnotes</h3>"
0216 Last_Footnote_Bulletted = "Yes"
0217 Do While Not rsNotesLinks.EOF
0218 'Format the in-page Footnotes
0219 If rsNotesLinks(1) = rsNotesLinks(4) Then 'Allow for Duplicate FNs
0220 If Last_Footnote_Bulletted = "Yes" Then
0221 strLine_Break = ""
0222 Else
0223 strLine_Break = "<BR><BR>"
0224 End If
0225 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 ...
0226 Last_Footnote_Bulletted = "Yes"
0227 Else
0228 Last_Footnote_Bulletted = "No"
0229 End If
0230 'Check, and list, Duplicate FNs
0231 strDup_FNs = ""
0232 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;")
0233 If Not rsFNCheck.EOF Then
0234 rsFNCheck.MoveFirst
0235 Do While Not rsFNCheck.EOF
0236 strDup_FNs = strDup_FNs & "<A HREF=""#On-Page_Return_" & rsTableToRead.Fields(0) & "_" & rsFNCheck.Fields(1).Value & """>, " & rsFNCheck.Fields(1).Value & "</A>"
0237 rsFNCheck.MoveNext
0238 Loop
0239 End If
0240 Set rsFNCheck = Nothing
0241 strLine_Archive = strLine_Archive & "<a name=""On-Page_Link_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(1).Value & """></A>" & strLine_Break & "<U><A HREF=""#On-Page_Return_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(1).Value & """>" & "<B>Footnote" & IIf(strDup_FNs = "", " ", "s ") & rsNotesLinks.Fields(1).Value & "</A>" & strDup_FNs & "</B></U>: " & rsNotesLinks.Fields(2).Value
0242 End If
0243 rsNotesLinks.MoveNext
0244 Loop
0245 strLine_Archive = strLine_Archive & "<BR>"
0246 strLine_Archive = Remove_Dummy_Ref(strLine_Archive)
0247 strLine_Archive = WebEncode(strLine_Archive)
0248 strLine_Archive = ImageRef(strLine_Archive, "Notes", "N", Note_ID, Archive_Timestamp)
0249 OK = Reference_Books(strLine_Archive, "N", Note_ID, Archive_Timestamp)
0250 OK = Reference_Author(strLine_Archive, "N", Note_ID, Archive_Timestamp) 'Replace the Author References by hyperlinks
0251 OK = Reference_Note_Links(strLine_Archive, "N", Note_ID, Archive_Timestamp) 'Replace the Note Links References by hyperlinks
0252 OK = Reference_Reference(strLine_Archive)
0253 OK = Reference_Tables(strLine_Archive)
0254 OK = Reference_Queries(strLine_Archive)
0255 OK = Reference_Code(strLine_Archive)
0256 OK = Reference_Papers(strLine_Archive, "N", Note_ID, Archive_Timestamp)
0257 OK = Reference_Notes(strLine_Archive, "N", Note_ID, Archive_Timestamp)
0258 OK = Reference_Webrefs(strLine_Archive, "N", Note_ID, Archive_Timestamp)
0259 strLine_Archive = NumberedBullets(strLine_Archive)
0260 strLine_Archive = Bullets(strLine_Archive)
0261 OK = Mark_Colours(strLine_Archive)
0262 tsTextFile_Archive.WriteLine strLine_Archive
0263End If
0264Set rsNotesLinks = Nothing
0265If Test_Flag = True Then
0266 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " In-page Footnotes output"
0267 sw2.StartTimer
0268End If
0269'Output the links to printable versions ... if System Parameter Set
0270If Archive_Printable_Versions = True Then
0271 If InStr(rsTableToRead.Fields(2), "<B>Printable Version</B>:") = 0 And InStr(rsTableToRead.Fields(2), "<B>Printable Versions</B>:") = 0 Then 'ie. not already a manually-created link to printable versions
0272 strControlQuery = "Select Notes_To_Print.* FROM Notes_To_Print where Notes_To_Print.Note_ID = " & rsTableToRead.Fields(0) & " ORDER BY Notes_To_Print.Max_Depth;"
0273 Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0274 If Not rsNotesLinks.EOF Then
0275 strPrefix = ""
0276 rsNotesLinks.MoveFirst
0277 strLine_Archive = "<br><hr><h3 class = ""Left"">Printable Version:</h3> <UL><LI>Follow "
0278 strMulti_Prints = "No"
0279 Do While Not rsNotesLinks.EOF
0280 'Write out each link in one bulletted string
0281 'But print the Note
0282 strPrintDuplicateFootnoteRefs = rsNotesLinks.Fields(4) & ""
0283 strPrintReadingLists = rsNotesLinks.Fields(3) & ""
0284 OK = NoteForPrinting(rsTableToRead.Fields(0), rsNotesLinks.Fields(1), rsNotesLinks.Fields(2), IIf(Notes_Group_Name = "Supervisions", 10, 0), Last_Changed_Timestamp, "No")
0285 strLine_Archive = strLine_Archive & strPrefix & "(<A Href=""Notes_Print/NotesPrint_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(1) & IIf(rsNotesLinks.Fields(2) & "" = "Yes", "_P", "") & IIf(strPrintReadingLists = "Yes", "_R", "") & IIf(strPrintDuplicateFootnoteRefs = "Yes", "_D", "") & "_" & Last_Changed_Timestamp & ".htm"" TARGET = ""_top"">this link</A>) for level " & rsNotesLinks.Fields(1).Value & IIf(strPrintReadingLists = "Yes", IIf(strPrintDuplicateFootnoteRefs = "Yes", " (with reading list and duplicate footnotes indicated)", " (with reading list)"), IIf(strPrintDuplicateFootnoteRefs = "Yes", " (with duplicate footnotes indicated)", ""))
0286 rsNotesLinks.MoveNext
0287 If rsNotesLinks.EOF Then
0288 strPrefix = ""
0289 Else
0290 strPrefix = ", and </li><LI>Follow "
0291 strMulti_Prints = "Yes"
0292 End If
0293 Loop
0294 strLine_Archive = strLine_Archive & ".</li></UL><BR>"
0295 If strMulti_Prints = "Yes" Then
0296 strLine_Archive = ReplaceCode(strLine_Archive, "Printable Version", "Printable Versions")
0297 End If
0298 tsTextFile_Archive.WriteLine strLine_Archive
0299 End If
0300 End If
0301End If
0302If Test_Flag = True Then
0303 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Printable versions output"
0304 sw2.StartTimer
0305End If
0306'Current Live Version
0307 strControlQuery = "SELECT Notes.Last_Changed, Notes.Item_Title, Len(Notes.Item_Text), CDate([Last_Changed]/1000) AS [Time Stamp] FROM Notes WHERE (((Notes.ID)=" & rsTableToRead.Fields(0) & "));"
0308Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0309If Not rsNotesLinks.EOF Then
0310 rsNotesLinks.MoveFirst
0311 Latest_Version_Timestamp = rsNotesLinks.Fields(0)
0312 strLine_Archive = "<a name=""LiveVersion""></a><BR><HR><h3 class= ""Left"">Live Version of this Archived Note</h3>"
0313 tsTextFile_Archive.WriteLine strLine_Archive
0314 strLine_Archive = "<TABLE class = ""ReadingList"" WIDTH=700>"
0315 tsTextFile_Archive.WriteLine strLine_Archive
0316 strLine_Archive = "<TR><TD WIDTH=""20%"" class = ""BridgeCenter""><strong>Date</strong></TD>"
0317 tsTextFile_Archive.WriteLine strLine_Archive
0318 strLine_Archive = "<TD WIDTH=""10%"" class = ""BridgeRight""><strong>Length</strong></TD>"
0319 tsTextFile_Archive.WriteLine strLine_Archive
0320 strLine_Archive = "<TD WIDTH=""70%"" class = ""BridgeLeft""><strong>Title</strong></TD></TR>"
0321 tsTextFile_Archive.WriteLine strLine_Archive
0322 strLine_Archive = "<TR><TD class = ""BridgeCenter"">" & rsNotesLinks.Fields(3).Value & "</TD>"
0323 tsTextFile_Archive.WriteLine strLine_Archive
0324 strLine_Archive = "<TD class = ""BridgeRight"">" & rsNotesLinks.Fields(2).Value & "</TD>"
0325 tsTextFile_Archive.WriteLine strLine_Archive
0326 strLine_Archive = "<TD class = ""BridgeLeft""><A HREF = ""Notes_" & rsTableToRead.Fields(0) & ".htm"">" & rsNotesLinks.Fields(1).Value & "</A>" & "</TD></TR>"
0327 tsTextFile_Archive.WriteLine strLine_Archive
0328 strLine_Archive = "</TABLE></CENTER>"
0329 tsTextFile_Archive.WriteLine strLine_Archive
0330End If
0331Set rsNotesLinks = Nothing
0332'Table of previous versions
0333 strControlQuery = "SELECT Notes_Archive.Timestamp, Notes_Archive.Item_Title, Len(Notes_Archive.Item_Text), CDate([Timestamp]/1000) AS [Time Stamp], Notes_Archive.Status FROM Notes_Archive WHERE (((Notes_Archive.Timestamp) < " & Last_Changed_Timestamp & ") And ((Notes_Archive.ID) = " & rsTableToRead.Fields(0) & ")) ORDER BY Notes_Archive.Timestamp DESC;"
0334Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0335PreviousVersionCount = rsNotesLinks.RecordCount
0336Total_Previous = 0
0337If PreviousVersionCount > 12 Then
0338 Total_Previous = PreviousVersionCount
0339 PreviousVersionCount = 12
0340End If
0341If Not rsNotesLinks.EOF Then
0342 If PreviousVersionCount > 1 Then
0343 strLine_Archive = "<a name=""TableOfPreviousVersions""></a><BR><HR><h3 class= ""Left"">Table of " & IIf(Total_Previous = 0, "the ", "") & PreviousVersionCount & " Earlier Versions of this Note" & IIf(Total_Previous = 0, "", " (of " & Total_Previous & ")") & "</h3>"
0344 Else
0345 strLine_Archive = "<a name=""TableOfPreviousVersions""></a><BR><HR><h3 class= ""Left"">Earlier Version of this Note</h3>"
0346 End If
0347 tsTextFile_Archive.WriteLine strLine_Archive
0348 strLine_Archive = "<TABLE class = ""ReadingList"" WIDTH=700>"
0349 tsTextFile_Archive.WriteLine strLine_Archive
0350 strLine_Archive = "<TR><TD WIDTH=""20%"" class = ""BridgeCenter""><strong>Date</strong></TD>"
0351 tsTextFile_Archive.WriteLine strLine_Archive
0352 strLine_Archive = "<TD WIDTH=""10%"" class = ""BridgeRight""><strong>Length</strong></TD>"
0353 tsTextFile_Archive.WriteLine strLine_Archive
0354 strLine_Archive = "<TD WIDTH=""70%"" class = ""BridgeLeft""><strong>Title</strong></TD></TR>"
0355 tsTextFile_Archive.WriteLine strLine_Archive
0356 rsNotesLinks.MoveFirst
0357 Do While Not (rsNotesLinks.EOF Or PreviousVersionCount < 1)
0358 PreviousVersionCount = PreviousVersionCount - 1
0359 strLine_Archive = "<TR><TD class = ""BridgeCenter"">" & rsNotesLinks.Fields(3).Value & "</TD>"
0360 tsTextFile_Archive.WriteLine strLine_Archive
0361 strLine_Archive = "<TD class = ""BridgeRight"">" & rsNotesLinks.Fields(2).Value & "</TD>"
0362 tsTextFile_Archive.WriteLine strLine_Archive
0363 strLine_Archive = "<TD class = ""BridgeLeft""><A HREF = ""Notes_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(0).Value & ".htm"">" & rsNotesLinks.Fields(1).Value & "</A>" & "</TD></TR>"
0364 tsTextFile_Archive.WriteLine strLine_Archive
0365 rsNotesLinks.MoveNext
0366 Loop
0367 strLine_Archive = "</TABLE></CENTER>"
0368 tsTextFile_Archive.WriteLine strLine_Archive
0369End If
0370Set rsNotesLinks = Nothing
0371'Table of Later versions (using some inappropriate variables from the above code!)
0372 strControlQuery = "SELECT Notes_Archive.Timestamp, Notes_Archive.Item_Title, Len(Notes_Archive.Item_Text), CDate([Timestamp]/1000) AS [Time Stamp], Notes_Archive.Status FROM Notes_Archive WHERE (((Notes_Archive.Timestamp) > " & Last_Changed_Timestamp & ") And ((Notes_Archive.ID) = " & rsTableToRead.Fields(0) & ")) ORDER BY Notes_Archive.Timestamp DESC;"
0373Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)!
0374PreviousVersionCount = rsNotesLinks.RecordCount
0375If PreviousVersionCount > 0 Then
0376 rsNotesLinks.MoveFirst
0377End If
0378Total_Previous = 0
0379If PreviousVersionCount > 12 Then
0380 Total_Previous = PreviousVersionCount
0381 PreviousVersionCount = 12
0382 'Position at the first record
0383 i = Total_Previous - 12
0384 Do Until i = 0
0385 rsNotesLinks.MoveNext
0386 i = i - 1
0387 Loop
0388End If
0389If Not rsNotesLinks.EOF Then
0390 If PreviousVersionCount > 1 Then
0391 If rsNotesLinks.Fields(0) = Latest_Version_Timestamp Then
0392 rsNotesLinks.MoveNext
0393 PreviousVersionCount = PreviousVersionCount - 1
0394 End If
0395 If PreviousVersionCount > 1 Then
0396 strLine_Archive = "<a name=""TableOfLaterVersions""></a><BR><HR><h3 class= ""Left"">Table of " & IIf(Total_Previous = 0, "the ", "") & PreviousVersionCount & " Later Versions of this Note" & IIf(Total_Previous = 0, "", " (of " & Total_Previous & ")") & "</h3>"
0397 Else
0398 strLine_Archive = "<a name=""TableOfLaterVersions""></a><BR><HR><h3 class= ""Left"">Later Version of this Note</h3>"
0399 End If
0400 tsTextFile_Archive.WriteLine strLine_Archive
0401 strLine_Archive = "<TABLE class = ""ReadingList"" WIDTH=700>"
0402 tsTextFile_Archive.WriteLine strLine_Archive
0403 strLine_Archive = "<TR><TD WIDTH=""20%"" class = ""BridgeCenter""><strong>Date</strong></TD>"
0404 tsTextFile_Archive.WriteLine strLine_Archive
0405 strLine_Archive = "<TD WIDTH=""10%"" class = ""BridgeRight""><strong>Length</strong></TD>"
0406 tsTextFile_Archive.WriteLine strLine_Archive
0407 strLine_Archive = "<TD WIDTH=""70%"" class = ""BridgeLeft""><strong>Title</strong></TD></TR>"
0408 tsTextFile_Archive.WriteLine strLine_Archive
0409 Do While Not (rsNotesLinks.EOF Or PreviousVersionCount < 1)
0410 PreviousVersionCount = PreviousVersionCount - 1
0411 strLine_Archive = "<TR><TD class = ""BridgeCenter"">" & rsNotesLinks.Fields(3).Value & "</TD>"
0412 tsTextFile_Archive.WriteLine strLine_Archive
0413 strLine_Archive = "<TD class = ""BridgeRight"">" & rsNotesLinks.Fields(2).Value & "</TD>"
0414 tsTextFile_Archive.WriteLine strLine_Archive
0415 strLine_Archive = "<TD class = ""BridgeLeft""><A HREF = ""Notes_" & rsTableToRead.Fields(0) & "_" & rsNotesLinks.Fields(0).Value & ".htm"">" & rsNotesLinks.Fields(1).Value & "</A>" & "</TD></TR>"
0416 tsTextFile_Archive.WriteLine strLine_Archive
0417 rsNotesLinks.MoveNext
0418 Loop
0419 strLine_Archive = "</TABLE></CENTER>"
0420 tsTextFile_Archive.WriteLine strLine_Archive
0421 End If
0422End If
0423Set rsNotesLinks = Nothing
0424If Test_Flag = True Then
0425 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Table of other versions output"
0426 sw2.StartTimer
0427End If
0428'Footer Table & Headers
0429strLine_Archive = "<BR><HR><BR><CENTER><TABLE class = ""Bridge"" WIDTH=950><TR>"
0430tsTextFile_Archive.WriteLine strLine_Archive
0431strLine_Archive = "<TH WIDTH=""25%"">This version updated</TH>"
0432tsTextFile_Archive.WriteLine strLine_Archive
0433If rsTableToRead.Fields(8).Value = "Yes" Then
0434 strLine_Archive = "<TH WIDTH=""50%"">Reading List for this Topic</TH>"
0435 tsTextFile_Archive.WriteLine strLine_Archive
0436Else
0437 strLine_Archive = "<TH WIDTH=""50%"">Reference for this Topic</TH>"
0438 tsTextFile_Archive.WriteLine strLine_Archive
0439End If
0440strLine_Archive = "<TH WIDTH=""50%"">Parent Topic</TH></TR>"
0441tsTextFile_Archive.WriteLine strLine_Archive
0442'Last updated Footer
0443DatePrint = Val(rsTableToRead.Fields(6) & "") / 1000
0444strLine_Archive = "<TR><TD WIDTH=""25%"">" & DatePrint & "</TD>"
0445tsTextFile_Archive.WriteLine strLine_Archive
0446'Reading-List Footer
0447If rsTableToRead.Fields(8).Value = "Yes" Then
0448 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) & "));"
0449 Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0450 If Not rsNotesLinks.EOF Then
0451 rsNotesLinks.MoveFirst
0452 strLine_Archive = "<A HREF = ""../../PaperCatalogIdentityFullSubTopic_" & rsNotesLinks.Fields(0) & ".htm"" TARGET = ""_top"">" & rsTableToRead.Fields(1) & "</A>"
0453 strLine_Archive = "<TD WIDTH=""50%"">" & strLine_Archive & "</TD>"
0454 Else
0455 strLine_Archive = "<TD WIDTH=""50%"">None available</TD>"
0456 End If
0457 tsTextFile_Archive.WriteLine strLine_Archive
0458Else
0459 strLine_Archive = "<TD WIDTH=""50%"">" & rsTableToRead.Fields(0).Value & " (" & rsTableToRead.Fields(1).Value & ")</TD>"
0460 tsTextFile_Archive.WriteLine strLine_Archive
0461End If
0462If Test_Flag = True Then
0463 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Reading-List footer output"
0464 sw2.StartTimer
0465End If
0466'Parent Topic Footer
0467strLine_Archive = "<TD WIDTH=""25%"">" & rsTableToRead.Fields(5) & "</TD></TR>"
0468tsTextFile_Archive.WriteLine strLine_Archive
0469strLine_Archive = "</TABLE><br><hr><br>"
0470tsTextFile_Archive.WriteLine strLine_Archive
0471'Links Out Footer
0472strNotesTitle_Saved = "xxxxxx"
0473iNotes_Title_Index = 1
0474 strControlQuery = "SELECT Cross_Reference.Called_ID, Cross_Reference.Called_Timestamp, [Notes_Archive]![Item_Title] AS Item_Title, Notes_Archive_1.Note_Group, [Notes_Archive]![Note_Group] AS Note_Group2, Count(Cross_Reference.Calling_NameRef) AS CountOfCalling_NameRef FROM (Cross_Reference INNER JOIN Notes_Archive AS Notes_Archive_1 ON (Cross_Reference.Calling_Timestamp = Notes_Archive_1.Timestamp) AND (Cross_Reference.Calling_ID = Notes_Archive_1.ID)) INNER JOIN Notes_Archive ON (Cross_Reference.Called_Timestamp = Notes_Archive.Timestamp) AND (Cross_Reference.Called_ID = Notes_Archive.ID) WHERE (((Cross_Reference.Calling_ID) = " & Note_ID & ") And ((Cross_Reference.Calling_Timestamp) = " & Archive_Timestamp & ") And ((Cross_Reference.Calling_Type) = ""N"") And ((Cross_Reference.Called_Type) = ""N"")) GROUP BY Cross_Reference.Called_ID, Cross_Reference.Called_Timestamp, [Notes_Archive]![Item_Title], Notes_Archive_1.Note_Group, [Notes_Archive]![Note_Group] ORDER BY [Notes_Archive]![Item_Title];"
0475Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0476If Not rsNotesLinks.EOF Then
0477 strLine_Archive = "<h3>Summary of Notes Links from this Page</h3>"
0478 tsTextFile_Archive.WriteLine strLine_Archive
0479 'Title-based jump table
0480 ' ... Header
0481 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;"
0482 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0483 rsTableControl2.MoveFirst
0484 Do While Not rsTableControl2.EOF
0485 strLine_Archive = rsTableControl2.Fields(0) & ""
0486 tsTextFile_Archive.WriteLine strLine_Archive
0487 rsTableControl2.MoveNext
0488 Loop
0489 ' ... Rows
0490 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;"
0491 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0492 rsTableControl2.MoveFirst
0493 rsNotesLinks.MoveFirst
0494 Do While (Not rsTableControl2.EOF Or Not rsNotesLinks.EOF)
0495 If rsTableControl2.EOF Then
0496 rsTableControl2.MoveFirst
0497 End If
0498 strLine_Archive = rsTableControl2.Fields(0) & ""
0499 x = InStr(1, strLine_Archive, "**Column")
0500 If x > 0 Then
0501 If Not rsNotesLinks.EOF Then
0502 iNotes_Title_Index = rsNotesLinks.Fields(5).Value
0503 'Find latest Timestamp for links
0504 FootNoteTimestamp = rsNotesLinks.Fields(1).Value
0505 'Determine if across secure area
0506 strDirectory = ""
0507 If rsNotesLinks.Fields(4) & "" <> 10 Then
0508 strDirectory = "../../Notes/"
0509 Else
0510 strDirectory = "../../Secure_Jen/"
0511 End If
0512 Y = "<A href = """ & strDirectory & "Notes_" & Find_New_Directory(rsNotesLinks.Fields(0).Value) & "/Notes_" & rsNotesLinks.Fields(0) & IIf(FootNoteTimestamp > 0, "_" & FootNoteTimestamp, "") & ".htm" & """>" & IIf(rsNotesLinks.Fields(2) & "" = "", "Title Missing", rsNotesLinks.Fields(2)) & IIf(iNotes_Title_Index > 1, " (" & iNotes_Title_Index & ")", "") & "</A>"
0513 Else
0514 Y = "&nbsp;"
0515 End If
0516 strLine_Archive = Left(strLine_Archive, x - 1) & Y & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0517 If Not rsNotesLinks.EOF Then
0518 rsNotesLinks.MoveNext
0519 End If
0520 tsTextFile_Archive.WriteLine strLine_Archive
0521 Else
0522 tsTextFile_Archive.WriteLine strLine_Archive
0523 End If
0524 rsTableControl2.MoveNext
0525 Loop
0526 ' ... Footer
0527 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;"
0528 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0529 rsTableControl2.MoveFirst
0530 Do While Not rsTableControl2.EOF
0531 strLine_Archive = rsTableControl2.Fields(0) & ""
0532 tsTextFile_Archive.WriteLine strLine_Archive
0533 rsTableControl2.MoveNext
0534 Loop
0535End If
0536If Test_Flag = True Then
0537 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Links-out footer output"
0538 sw2.StartTimer
0539End If
0540'Links In Footer
0541strNotesTitle_Saved = ""
0542 strControlQuery = "SELECT Cross_Reference.Calling_ID, Cross_Reference.Calling_Timestamp, Notes_Archive_1.Item_Title, Notes_Archive_1.Note_Group, [Notes_Archive]![Note_Group] AS Note_Group2, Cross_Reference.Calling_NameRef, Count(Cross_Reference.Calling_NameRef) AS CountOfCalling_NameRef FROM (Cross_Reference INNER JOIN Notes_Archive ON (Cross_Reference.Called_Timestamp = Notes_Archive.Timestamp) AND (Cross_Reference.Called_ID = Notes_Archive.ID)) INNER JOIN Notes_Archive AS Notes_Archive_1 ON (Cross_Reference.Calling_Timestamp = Notes_Archive_1.Timestamp) AND (Cross_Reference.Calling_ID = Notes_Archive_1.ID) WHERE (((Cross_Reference.Called_Type) = ""N"") And ((Cross_Reference.Called_ID) = " & Note_ID & ") And ((Cross_Reference.Called_Timestamp) = " & Archive_Timestamp & ") And ((Cross_Reference.Calling_Type) = ""N"")) "
0543 strControlQuery = strControlQuery & "GROUP BY Cross_Reference.Calling_ID, Cross_Reference.Calling_Timestamp, Notes_Archive_1.Item_Title, Notes_Archive_1.Note_Group, [Notes_Archive]![Note_Group], Cross_Reference.Calling_NameRef ORDER BY Notes_Archive_1.Item_Title;"
0544Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0545If Not rsNotesLinks.EOF Then
0546 strLine_Archive = "<BR><HR><BR><h3>Summary of Note Links to this Page</h3>"
0547 tsTextFile_Archive.WriteLine strLine_Archive
0548 'Title-based jump table
0549 ' ... Header
0550 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;"
0551 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0552 rsTableControl2.MoveFirst
0553 Do While Not rsTableControl2.EOF
0554 strLine_Archive = rsTableControl2.Fields(0) & ""
0555 tsTextFile_Archive.WriteLine strLine_Archive
0556 rsTableControl2.MoveNext
0557 Loop
0558 ' ... Rows
0559 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;"
0560 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0561 rsTableControl2.MoveFirst
0562 rsNotesLinks.MoveFirst
0563 FootNoteTimestamp_Saved = 999
0564 Link_Title_Saved = "ZZZZZ"
0565 Link_Title_Output = ""
0566 Link_ID_Saved = 0
0567 Print_Cell = True
0568 Do While (Not rsTableControl2.EOF Or Not rsNotesLinks.EOF)
0569 If rsTableControl2.EOF Then
0570 rsTableControl2.MoveFirst
0571 End If
0572 strLine_Archive = rsTableControl2.Fields(0) & ""
0573 x = InStr(1, strLine_Archive, "**Column")
0574 If x > 0 Then
0575 i = 1
0576 Print_Cell = True
0577 If Not rsNotesLinks.EOF Then
0578 NameRef = "#N" & Note_ID & "_" & rsNotesLinks.Fields(5)
0579 'Find latest Timestamp for links
0580 FootNoteTimestamp = rsNotesLinks.Fields(1).Value
0581 Link_Title = rsNotesLinks.Fields(2)
0582 Link_ID = rsNotesLinks.Fields(0)
0583 'Determine if across secure area
0584 strDirectory = ""
0585 If rsNotesLinks.Fields(3) <> 10 Then
0586 strDirectory = "../../Notes/"
0587 Else
0588 strDirectory = "../../Secure_Jen/"
0589 End If
0590 Y = "<A href = """ & strDirectory & "Notes_" & Find_New_Directory(rsNotesLinks.Fields(0).Value) & "/Notes_" & rsNotesLinks.Fields(0) & IIf(FootNoteTimestamp > 0, "_" & FootNoteTimestamp, "") & ".htm" & NameRef & """>" & Link_Title & "</A>"
0591 If Link_Title_Output_Saved = Link_Title_Saved Then
0592 If FootNoteTimestamp <> 0 Then
0593 Y = Y & "<br>" & CDate(FootNoteTimestamp / 1000)
0594 End If
0595 End If
0596 Else
0597 Y = "&nbsp;"
0598 End If
0599 If Not rsNotesLinks.EOF Then
0600 'Read the next link
0601 FootNoteTimestamp_Saved = FootNoteTimestamp
0602 Link_Title_Saved = Link_Title
0603 Link_ID_Saved = Link_ID
0604 rsNotesLinks.MoveNext
0605 If Not rsNotesLinks.EOF Then
0606 'Look for ways of compressing the size of the link display table
0607 FootNoteTimestamp = rsNotesLinks.Fields(1).Value
0608 Link_Title = rsNotesLinks.Fields(2)
0609 If (Link_Title = Link_Title_Saved) And (Link_ID_Saved = Link_ID) Then
0610 Link_Title_Output_Saved = Link_Title_Saved
0611 Do Until (Link_Title <> Link_Title_Saved) Or (Link_ID_Saved <> Link_ID)
0612 NameRef = "#N" & Note_ID & "_" & rsNotesLinks.Fields(5)
0613 i = i + 1
0614 Y = Y & ", <A href = """ & strDirectory & "Notes_" & Find_New_Directory(rsNotesLinks.Fields(0).Value) & "/Notes_" & rsNotesLinks.Fields(0) & IIf(FootNoteTimestamp > 0, "_" & FootNoteTimestamp, "") & ".htm" & NameRef & """>" & i & "</A>"
0615 Print_Cell = False
0616 rsNotesLinks.MoveNext
0617 If Not rsNotesLinks.EOF Then
0618 FootNoteTimestamp = rsNotesLinks.Fields(1).Value
0619 Link_Title = rsNotesLinks.Fields(2)
0620 Else
0621 FootNoteTimestamp = FootNoteTimestamp_Saved + 1
0622 Link_Title_Saved = Link_Title & " (x)"
0623 End If
0624 Loop
0625 i = 1
0626 Print_Cell = True
0627 If Not rsNotesLinks.EOF Then
0628 FootNoteTimestamp_Saved = rsNotesLinks.Fields(1).Value
0629 Link_Title_Saved = rsNotesLinks.Fields(2)
0630 Link_ID_Saved = rsNotesLinks.Fields(0)
0631 End If
0632 Else
0633 FootNoteTimestamp_Saved = rsNotesLinks.Fields(1).Value
0634 Link_Title_Saved = rsNotesLinks.Fields(2)
0635 Link_ID_Saved = rsNotesLinks.Fields(0)
0636 End If
0637 End If
0638 End If
0639 If Print_Cell = True Then
0640 strLine_Archive = Left(strLine_Archive, x - 1) & Y & Mid(strLine_Archive, x + 10, Len(strLine_Archive))
0641 tsTextFile_Archive.WriteLine strLine_Archive
0642 Link_Title_Output = Link_Title_Output_Saved
0643 End If
0644 Else
0645 tsTextFile_Archive.WriteLine strLine_Archive
0646 End If
0647 rsTableControl2.MoveNext
0648 Loop
0649 ' ... Footer
0650 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;"
0651 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0652 rsTableControl2.MoveFirst
0653 Do While Not rsTableControl2.EOF
0654 strLine_Archive = rsTableControl2.Fields(0) & ""
0655 tsTextFile_Archive.WriteLine strLine_Archive
0656 rsTableControl2.MoveNext
0657 Loop
0658 strLine_Archive = "<BR><HR><BR>"
0659 tsTextFile_Archive.WriteLine strLine_Archive
0660End If
0661If Test_Flag = True Then
0662 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Links-in footer output"
0663 sw2.StartTimer
0664End If
0665'Add the Reading List - note - need to populate Note_Usage_Temp first
0666' ... Only if this Notes_Group has Reading Lists, and the System Parameter is set on ...
0667If Archive_Reading_Lists = True Then
0668 strLine_Archive = "Select Note_Groups![ReadingList?] From Note_Groups Where Note_Groups.Note_Group = """ & rsTableToRead.Fields(4) & """;"
0669 Set rsTableControl2 = CurrentDb.OpenRecordset(strLine_Archive)
0670 rsTableControl2.MoveFirst
0671 If rsTableControl2.Fields(0).Value = "Yes" Then
0672 'Clear the Notes usage table
0673 DoCmd.RunSQL ("DELETE Note_Usage_Temp.* FROM Note_Usage_Temp;")
0674 'Prepopulate with the main note
0675 strLine_Archive = "SELECT Note_Usage_Temp.* FROM Note_Usage_Temp;"
0676 Set rsTableControl2 = CurrentDb.OpenRecordset(strLine_Archive)
0677 rsTableControl2.AddNew
0678 rsTableControl2.Fields(0) = rsTableToRead.Fields(0)
0679 rsTableControl2.Fields(1) = "Main Text"
0680 rsTableControl2.Fields(2) = 0
0681 rsTableControl2.Fields(3) = 0
0682 rsTableControl2.Fields(4) = 0
0683 rsTableControl2.Update
0684 OK = AddReading_List(rsTableToRead.Fields(1), tsTextFile_Archive, "Non-Print")
0685 End If
0686End If
0687If Test_Flag = True Then
0688 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Reading List output"
0689 sw2.StartTimer
0690End If
0691'Add Colour Conventions
0692strLine_Archive = "<a name=""ColourConventions""></a><h3 class = ""Left"">Text Colour Conventions</h3></center><OL TYPE=""1"">"
0693For i = 0 To 19
0694 If Colour_Table(i, 4) = "1" Then
0695 strLine_Archive = strLine_Archive & "<LI><FONT COLOR = """ & Colour_Table(i, 1) & """>" & Colour_Table(i, 2) & "</FONT>: " & Colour_Table(i, 3) & "</li>"
0696 End If
0697Next i
0698strLine_Archive = strLine_Archive & "</OL><BR>"
0699tsTextFile_Archive.WriteLine strLine_Archive
0700'Note-page Footer
0701strLine_Archive = "<center>"
0702 strControlTable = "Notes"
0703 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;"
0704Set rsFooterControl = CurrentDb.OpenRecordset(strControlQuery)
0705rsFooterControl.MoveFirst
0706Do While Not rsFooterControl.EOF
0707 strLine_Archive = strLine_Archive & rsFooterControl.Fields(0)
0708 OK = Replace_Timestamp(strLine_Archive)
0709 rsFooterControl.MoveNext
0710Loop
0711tsTextFile_Archive.WriteLine strLine_Archive
0712'Copy to Transfer
0713If Test_Flag = True Then
0714 sw2.StartTimer
0715End If
0716If rsTableToRead.Fields(7).Value = "Yes" Then
0717 OK = CopyToTransfer(strFolder, strFilename_Archived, "Private")
0718Else
0719 OK = CopyToTransfer(strFolder, strFilename_Archived)
0720End If
0721If Test_Flag = True Then
0722 Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " CopyToTransfer"
0723 Debug.Print Now(); strFilename_Archived; sw.EndTimer; "Milliseconds"
0724End If
0725DoEvents
0726If Test_Flag = True Then
0727 Stop
0728End If
0729'Tidy Up
0730Set rsNotesLinks = Nothing
0731Set rsTableControl = Nothing
0732Set rsTableToRead = Nothing
0733Set fsoTextFile = Nothing
0734If Test_Flag = True Then
0735 Set sw = Nothing
0736 Set sw2 = Nothing
0737End If
0738End Function

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


© Theo Todman, June 2007 - May 2025. Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Philosophy Page Return to Theo Todman's Home Page