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