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