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