Line-No. / Ref. | Code Line |
0001 | Public Function OutputNotesWebPage_Archived(Note_ID, Optional Archive_Timestamp) |
0002 | Dim fsoTextFile As FileSystemObject |
0003 | Dim tsTextFile_Archive As TextStream |
0004 | Dim tsTextFile As TextStream |
0005 | Dim rsTableToRead As Recordset |
0006 | Dim rsTableControl As Recordset |
0007 | Dim rsFooterControl As Recordset |
0008 | Dim rsTableControl2 As Recordset |
0009 | Dim rsNotesLinks As Recordset |
0010 | Dim rsFNCheck As Recordset |
0011 | Dim strControlQuery As String |
0012 | Dim strLine_Archive As String |
0013 | Dim x As Long |
0014 | Dim x1 As Long |
0015 | Dim Y As String |
0016 | Dim z1 As Long |
0017 | Dim strNotesRoot As String |
0018 | Dim strNotesRootSecure As String |
0019 | Dim strNotesTitle_Saved As String |
0020 | Dim iNotes_Title_Index As Integer |
0021 | Dim Frozen_Timestamp As Long |
0022 | Dim Duration |
0023 | Dim DatePrint As Date |
0024 | Dim strFilename_Archived As String |
0025 | Dim FootNoteTimestamp As Long |
0026 | Dim FootNoteTimestamp_Saved As Long |
0027 | Dim strDirectory As String |
0028 | Dim Notes_Group_Name As String |
0029 | Dim strSearch As String |
0030 | Dim strNote As String |
0031 | Dim i As Integer |
0032 | Dim Notes_Subdirectory As String |
0033 | Dim Temp_Note_ID |
0034 | Dim PreviousVersionCount As Integer |
0035 | Dim strQuery As String |
0036 | Dim strPrefix As String |
0037 | Dim strMulti_Prints As String |
0038 | Dim Last_Footnote_Bulletted As String |
0039 | Dim strLine_Break As String |
0040 | Dim As_At_Text As String |
0041 | Dim Latest_Version_Timestamp As Long |
0042 | Dim Link_Title As String |
0043 | Dim Link_Title_Saved As String |
0044 | Dim Link_Title_Output As String |
0045 | Dim Link_Title_Output_Saved As String |
0046 | Dim Print_Cell As Boolean |
0047 | Dim Total_Previous As Integer |
0048 | Dim strDup_FNs As String |
0049 | Dim Link_ID As Integer |
0050 | Dim Link_ID_Saved As Integer |
0051 | Dim sw As StopWatch |
0052 | Dim sw2 As StopWatch |
0053 | 'Test_Flag = True |
0054 | If Test_Flag = True Then |
0055 | Set sw = New StopWatch |
0056 | Set sw2 = New StopWatch |
0057 | sw.StartTimer |
0058 | End If |
0059 | If Test_Flag = True Then |
0060 | sw2.StartTimer |
0061 | End If |
0062 | 'Read the Note |
0063 | If 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 |
0066 | Else |
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 & ";" |
0069 | End If |
0070 | Set 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 |
0086 | If rsTableToRead.EOF Then |
0087 | MsgBox ("Note " & Note_ID & IIf(IsMissing(Archive_Timestamp), "", " (ID " & Archive_Timestamp & ")") & " does not exist. ") |
0088 | Exit Function |
0089 | Else |
0090 | rsTableToRead.MoveFirst |
0091 | End If |
0092 | strNotesRoot = "C:\Theo's Files\Websites\Theo's Website\Notes\" |
0093 | strNotesRootSecure = "C:\Theo's Files\Websites\Theo's Website\Secure_Jen\" |
0094 | strLine_Archive = "" |
0095 | Set fsoTextFile = Nothing |
0096 | Set 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) |
0098 | strFolder = strNotesRoot |
0099 | strFilename_Archived = "Dummy.htm" |
0100 | Set tsTextFile_Archive = fsoTextFile.CreateTextFile(strFolder & strFilename_Archived, True, True) |
0101 | strLine_Archive = "Dummy" |
0102 | tsTextFile_Archive.WriteLine strLine_Archive |
0103 | Set 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;" |
0105 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0106 | Clear_Colour_Usage |
0107 | Notes_Group_Name = rsTableToRead.Fields(4) |
0108 | If rsTableToRead.Fields(4) = "Supervisions" Then |
0109 | strFolder = strNotesRootSecure |
0110 | Else |
0111 | strFolder = strNotesRoot |
0112 | End If |
0113 | 'Find the Sub-directory |
0114 | Notes_Subdirectory = Find_New_Directory(rsTableToRead.Fields(0)) |
0115 | Notes_Subdirectory = "Notes_" & Notes_Subdirectory & "\" |
0116 | strFolder = strFolder & Notes_Subdirectory |
0117 | strFilename_Archived = "Notes_" & rsTableToRead.Fields(0) & "_" & Last_Changed_Timestamp & ".htm" |
0118 | Set tsTextFile_Archive = fsoTextFile.CreateTextFile(strFolder & strFilename_Archived, True, True) |
0119 | If Test_Flag = True Then |
0120 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Set-up complete" |
0121 | End If |
0122 | 'Format the page |
0123 | If Test_Flag = True Then |
0124 | sw2.StartTimer |
0125 | End If |
0126 | rsTableControl.MoveFirst |
0127 | Do 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 = " (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) & "" & rsTableToRead.Fields(1) & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive)) & "" |
0145 | End If |
0146 | Else |
0147 | If rsTableToRead.Fields(9) = False Then |
0148 | strLine_Archive = Left(strLine_Archive, x - 1) & "Theo Todman's Web Page - Notes Pages
" & rsTableToRead.Fields(4) & "" & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive)) |
0149 | Else |
0150 | strLine_Archive = Left(strLine_Archive, x - 1) & "Theo Todman's Web Page - Notes Pages
" & rsTableToRead.Fields(4) & "" & rsTableToRead.Fields(1) & "" & As_At_Text & Mid(strLine_Archive, x + 10, Len(strLine_Archive)) |
0151 | End If |
0152 | End If |
0153 | strLine_Archive = strLine_Archive & "
*** THIS IS NOT THE LATEST VERSION OF THIS NOTE ***" |
0154 | strLine_Archive = strLine_Archive & " (For the live version and other versions of this Note, see the tables at the end)
" |
0155 | If rsTableToRead.Fields(10) = True Then 'Respondent's Comment |
0156 | strLine_Archive = strLine_Archive & "(CORRESPONDENT'S COMMENTS)" |
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 & " For Text Colour-conventions (at end of page): Click Here. " |
0164 | Else |
0165 | strLine_Archive = strLine_Archive & " " |
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 |
0206 | Loop |
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;" |
0209 | Set rsNotesLinks = CurrentDb.OpenRecordset(strQuery) |
0210 | If Not rsNotesLinks.EOF Then |
0211 | rsNotesLinks.MoveFirst |
0212 | strLine_Archive = "|Colour_1|
In-Page Footnotes" |
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 = "
" |
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 & ", " & rsFNCheck.Fields(1).Value & "" |
0234 | rsFNCheck.MoveNext |
0235 | Loop |
0236 | End If |
0237 | Set rsFNCheck = Nothing |
0238 | strLine_Archive = strLine_Archive & "" & strLine_Break & "" & "Footnote" & IIf(strDup_FNs = "", " ", "s ") & rsNotesLinks.Fields(1).Value & "" & strDup_FNs & ": " & rsNotesLinks.Fields(2).Value |
0239 | End If |
0240 | rsNotesLinks.MoveNext |
0241 | Loop |
0242 | strLine_Archive = strLine_Archive & " " |
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 |
0260 | End If |
0261 | Set rsNotesLinks = Nothing |
0262 | If Test_Flag = True Then |
0263 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " In-page Footnotes output" |
0264 | sw2.StartTimer |
0265 | End If |
0266 | 'Output the links to printable versions ... if System Parameter Set |
0267 | If Archive_Printable_Versions = True Then |
0268 | If InStr(rsTableToRead.Fields(2), "Printable Version:") = 0 And InStr(rsTableToRead.Fields(2), "Printable Versions:") = 0 Then 'ie. not already a manually-created link to printable versions |
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 = "
Printable Version: |
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 & "(this link) for level " & rsNotesLinks.Fields(1).Value & IIf(strPrintReadingLists = "Yes", IIf(strPrintDuplicateFootnoteRefs = "Yes", " (with reading list and duplicate footnotes indicated)", " (with reading list)"), IIf(strPrintDuplicateFootnoteRefs = "Yes", " (with duplicate footnotes indicated)", "")) |
0283 | rsNotesLinks.MoveNext |
0284 | If rsNotesLinks.EOF Then |
0285 | strPrefix = "" |
0286 | Else |
0287 | strPrefix = ", and Follow " |
0288 | strMulti_Prints = "Yes" |
0289 | End If |
0290 | Loop |
0291 | strLine_Archive = strLine_Archive & ". " |
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 |
0298 | End If |
0299 | If Test_Flag = True Then |
0300 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Printable versions output" |
0301 | sw2.StartTimer |
0302 | End 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) & "));" |
0305 | Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)! |
0306 | If Not rsNotesLinks.EOF Then |
0307 | rsNotesLinks.MoveFirst |
0308 | Latest_Version_Timestamp = rsNotesLinks.Fields(0) |
0309 | strLine_Archive = "
Live Version of this Archived Note" |
0310 | tsTextFile_Archive.WriteLine strLine_Archive |
0311 | strLine_Archive = ""
0312 | tsTextFile_Archive.WriteLine strLine_Archive |
0313 | strLine_Archive = "Date | "
0314 | tsTextFile_Archive.WriteLine strLine_Archive |
0315 | strLine_Archive = "Length | " |
0316 | tsTextFile_Archive.WriteLine strLine_Archive |
0317 | strLine_Archive = "Title | | " |
0318 | tsTextFile_Archive.WriteLine strLine_Archive |
0319 | strLine_Archive = "" & rsNotesLinks.Fields(3).Value & " | "
0320 | tsTextFile_Archive.WriteLine strLine_Archive |
0321 | strLine_Archive = "" & rsNotesLinks.Fields(2).Value & " | " |
0322 | tsTextFile_Archive.WriteLine strLine_Archive |
0323 | strLine_Archive = "" & rsNotesLinks.Fields(1).Value & "" & " | | " |
0324 | tsTextFile_Archive.WriteLine strLine_Archive |
0325 | strLine_Archive = " | " |
0326 | tsTextFile_Archive.WriteLine strLine_Archive |
0327 | End If |
0328 | Set 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;" |
0331 | Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)! |
0332 | PreviousVersionCount = rsNotesLinks.RecordCount |
0333 | Total_Previous = 0 |
0334 | If PreviousVersionCount > 12 Then |
0335 | Total_Previous = PreviousVersionCount |
0336 | PreviousVersionCount = 12 |
0337 | End If |
0338 | If Not rsNotesLinks.EOF Then |
0339 | If PreviousVersionCount > 1 Then |
0340 | strLine_Archive = "
Table of " & IIf(Total_Previous = 0, "the ", "") & PreviousVersionCount & " Earlier Versions of this Note" & IIf(Total_Previous = 0, "", " (of " & Total_Previous & ")") & "" |
0341 | Else |
0342 | strLine_Archive = "
Earlier Version of this Note" |
0343 | End If |
0344 | tsTextFile_Archive.WriteLine strLine_Archive |
0345 | strLine_Archive = ""
0346 | tsTextFile_Archive.WriteLine strLine_Archive |
0347 | strLine_Archive = "Date | "
0348 | tsTextFile_Archive.WriteLine strLine_Archive |
0349 | strLine_Archive = "Length | " |
0350 | tsTextFile_Archive.WriteLine strLine_Archive |
0351 | strLine_Archive = "Title | | " |
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 = "" & rsNotesLinks.Fields(3).Value & " | "
0357 | tsTextFile_Archive.WriteLine strLine_Archive |
0358 | strLine_Archive = "" & rsNotesLinks.Fields(2).Value & " | " |
0359 | tsTextFile_Archive.WriteLine strLine_Archive |
0360 | strLine_Archive = "" & rsNotesLinks.Fields(1).Value & "" & " | | " |
0361 | tsTextFile_Archive.WriteLine strLine_Archive |
0362 | rsNotesLinks.MoveNext |
0363 | Loop |
0364 | strLine_Archive = " | " |
0365 | tsTextFile_Archive.WriteLine strLine_Archive |
0366 | End If |
0367 | Set 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;" |
0370 | Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) 'Just use this recordset (even though we're not "doing" NotesLinks)! |
0371 | PreviousVersionCount = rsNotesLinks.RecordCount |
0372 | If PreviousVersionCount > 0 Then |
0373 | rsNotesLinks.MoveFirst |
0374 | End If |
0375 | Total_Previous = 0 |
0376 | If 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 |
0385 | End If |
0386 | If 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 = "
Table of " & IIf(Total_Previous = 0, "the ", "") & PreviousVersionCount & " Later Versions of this Note" & IIf(Total_Previous = 0, "", " (of " & Total_Previous & ")") & "" |
0394 | Else |
0395 | strLine_Archive = "
Later Version of this Note" |
0396 | End If |
0397 | tsTextFile_Archive.WriteLine strLine_Archive |
0398 | strLine_Archive = ""
0399 | tsTextFile_Archive.WriteLine strLine_Archive |
0400 | strLine_Archive = "Date | "
0401 | tsTextFile_Archive.WriteLine strLine_Archive |
0402 | strLine_Archive = "Length | " |
0403 | tsTextFile_Archive.WriteLine strLine_Archive |
0404 | strLine_Archive = "Title | | " |
0405 | tsTextFile_Archive.WriteLine strLine_Archive |
0406 | Do While Not (rsNotesLinks.EOF Or PreviousVersionCount < 1) |
0407 | PreviousVersionCount = PreviousVersionCount - 1 |
0408 | strLine_Archive = "" & rsNotesLinks.Fields(3).Value & " | "
0409 | tsTextFile_Archive.WriteLine strLine_Archive |
0410 | strLine_Archive = "" & rsNotesLinks.Fields(2).Value & " | " |
0411 | tsTextFile_Archive.WriteLine strLine_Archive |
0412 | strLine_Archive = "" & rsNotesLinks.Fields(1).Value & "" & " | | " |
0413 | tsTextFile_Archive.WriteLine strLine_Archive |
0414 | rsNotesLinks.MoveNext |
0415 | Loop |
0416 | strLine_Archive = " | " |
0417 | tsTextFile_Archive.WriteLine strLine_Archive |
0418 | End If |
0419 | End If |
0420 | Set rsNotesLinks = Nothing |
0421 | If Test_Flag = True Then |
0422 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Table of other versions output" |
0423 | sw2.StartTimer |
0424 | End If |
0425 | 'Footer Table & Headers |
0426 | strLine_Archive = "
"
0427 | tsTextFile_Archive.WriteLine strLine_Archive |
0428 | strLine_Archive = "This version updated | " |
0429 | tsTextFile_Archive.WriteLine strLine_Archive |
0430 | If rsTableToRead.Fields(8).Value = "Yes" Then |
0431 | strLine_Archive = "Reading List for this Topic | " |
0432 | tsTextFile_Archive.WriteLine strLine_Archive |
0433 | Else |
0434 | strLine_Archive = "Reference for this Topic | " |
0435 | tsTextFile_Archive.WriteLine strLine_Archive |
0436 | End If |
0437 | strLine_Archive = "Parent Topic | | "
0438 | tsTextFile_Archive.WriteLine strLine_Archive |
0439 | 'Last updated Footer |
0440 | DatePrint = Val(rsTableToRead.Fields(6) & "") / 1000 |
0441 | strLine_Archive = "" & DatePrint & " | "
0442 | tsTextFile_Archive.WriteLine strLine_Archive |
0443 | 'Reading-List Footer |
0444 | If 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 = "" & rsTableToRead.Fields(1) & "" |
0450 | strLine_Archive = "" & strLine_Archive & " | " |
0451 | Else |
0452 | strLine_Archive = "None available | " |
0453 | End If |
0454 | tsTextFile_Archive.WriteLine strLine_Archive |
0455 | Else |
0456 | strLine_Archive = "" & rsTableToRead.Fields(0).Value & " (" & rsTableToRead.Fields(1).Value & ") | " |
0457 | tsTextFile_Archive.WriteLine strLine_Archive |
0458 | End If |
0459 | If Test_Flag = True Then |
0460 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Reading-List footer output" |
0461 | sw2.StartTimer |
0462 | End If |
0463 | 'Parent Topic Footer |
0464 | strLine_Archive = "" & rsTableToRead.Fields(5) & " | | " |
0465 | tsTextFile_Archive.WriteLine strLine_Archive |
0466 | strLine_Archive = " |
" |
0467 | tsTextFile_Archive.WriteLine strLine_Archive |
0468 | 'Links Out Footer |
0469 | strNotesTitle_Saved = "xxxxxx" |
0470 | iNotes_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];" |
0472 | Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) |
0473 | If Not rsNotesLinks.EOF Then |
0474 | strLine_Archive = "Summary of Notes Links from this Page" |
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 = " 0, "_" & FootNoteTimestamp, "") & ".htm" & """>" & IIf(rsNotesLinks.Fields(2) & "" = "", "Title Missing", rsNotesLinks.Fields(2)) & IIf(iNotes_Title_Index > 1, " (" & iNotes_Title_Index & ")", "") & "" |
0510 | Else |
0511 | Y = " " |
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 |
0532 | End If |
0533 | If Test_Flag = True Then |
0534 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Links-out footer output" |
0535 | sw2.StartTimer |
0536 | End If |
0537 | 'Links In Footer |
0538 | strNotesTitle_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;" |
0541 | Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery) |
0542 | If Not rsNotesLinks.EOF Then |
0543 | strLine_Archive = "
Summary of Note Links to this Page" |
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 = " 0, "_" & FootNoteTimestamp, "") & ".htm" & IIf(rsNotesLinks.Fields(5) <> 0, "#" & rsNotesLinks.Fields(5), "") & """>" & Link_Title & "" |
0587 | If Link_Title_Output_Saved = Link_Title_Saved Then |
0588 | If FootNoteTimestamp <> 0 Then |
0589 | Y = Y & " " & CDate(FootNoteTimestamp / 1000) |
0590 | End If |
0591 | End If |
0592 | Else |
0593 | Y = " " |
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 & ", 0, "_" & FootNoteTimestamp, "") & ".htm" & IIf(rsNotesLinks.Fields(5) <> 0, "#" & rsNotesLinks.Fields(5), "") & """>" & i & "" |
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 = "
" |
0654 | tsTextFile_Archive.WriteLine strLine_Archive |
0655 | End If |
0656 | If Test_Flag = True Then |
0657 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Links-in footer output" |
0658 | sw2.StartTimer |
0659 | End 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 ... |
0662 | If 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 |
0681 | End If |
0682 | If Test_Flag = True Then |
0683 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " Reading List output" |
0684 | sw2.StartTimer |
0685 | End If |
0686 | 'Add Colour Conventions |
0687 | strLine_Archive = "Text Colour Conventions" |
0688 | For i = 0 To 19 |
0689 | If Colour_Table(i, 4) = "1" Then |
0690 | strLine_Archive = strLine_Archive & "" & Colour_Table(i, 2) & ": " & Colour_Table(i, 3) & "" |
0691 | End If |
0692 | Next i |
0693 | strLine_Archive = strLine_Archive & " " |
0694 | tsTextFile_Archive.WriteLine strLine_Archive |
0695 | 'Note-page Footer |
0696 | strLine_Archive = "" |
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;" |
0699 | Set rsFooterControl = CurrentDb.OpenRecordset(strControlQuery) |
0700 | rsFooterControl.MoveFirst |
0701 | Do While Not rsFooterControl.EOF |
0702 | strLine_Archive = strLine_Archive & rsFooterControl.Fields(0) |
0703 | OK = Replace_Timestamp(strLine_Archive) |
0704 | rsFooterControl.MoveNext |
0705 | Loop |
0706 | tsTextFile_Archive.WriteLine strLine_Archive |
0707 | 'Copy to Transfer |
0708 | If Test_Flag = True Then |
0709 | sw2.StartTimer |
0710 | End If |
0711 | If rsTableToRead.Fields(7).Value = "Yes" Then |
0712 | OK = CopyToTransfer(strFolder, strFilename_Archived, "Private") |
0713 | Else |
0714 | OK = CopyToTransfer(strFolder, strFilename_Archived) |
0715 | End If |
0716 | If Test_Flag = True Then |
0717 | Debug.Print Now(); strFilename_Archived; sw2.EndTimer; "Milliseconds"; " CopyToTransfer" |
0718 | Debug.Print Now(); strFilename_Archived; sw.EndTimer; "Milliseconds" |
0719 | End If |
0720 | DoEvents |
0721 | If Test_Flag = True Then |
0722 | Stop |
0723 | End If |
0724 | 'Tidy Up |
0725 | Set rsNotesLinks = Nothing |
0726 | Set rsTableControl = Nothing |
0727 | Set rsTableToRead = Nothing |
0728 | Set fsoTextFile = Nothing |
0729 | If Test_Flag = True Then |
0730 | Set sw = Nothing |
0731 | Set sw2 = Nothing |
0732 | End If |
0733 | End Function |