Line-No. / Ref. | Code Line |
0001 | Public Sub CreatePapersWebTable() |
0002 | Dim fsoTextFile As FileSystemObject |
0003 | Dim strFileSuffix As String |
0004 | Dim strFileSuffix_Previous As String |
0005 | Dim strFileTitle As String |
0006 | Dim strFileTitle_Previous As String |
0007 | Dim tsTextFile As TextStream |
0008 | Dim tsJumpFile As TextStream |
0009 | Dim tsJumpFile2 As TextStream |
0010 | Dim tsJumpFile3 As TextStream |
0011 | Dim rsAbstractQuality As Recordset |
0012 | Dim rsTableToRead As Recordset |
0013 | Dim rsTableToReadLetters As Recordset |
0014 | Dim rsTableToReadJump2 As Recordset |
0015 | Dim rsTableToReadJump3 As Recordset |
0016 | Dim rsTableToReadJump4 As Recordset |
0017 | Dim rsTableControl As Recordset |
0018 | Dim rsTableControl2 As Recordset |
0019 | Dim rsTableControl3 As Recordset |
0020 | Dim rsTableControl_BB As Recordset |
0021 | Dim strControlQuery As String |
0022 | Dim strLine As String |
0023 | Dim strQuery As String |
0024 | Dim iTableColumns As Integer |
0025 | Dim iFieldNo As Integer |
0026 | Dim iIDCol As Integer |
0027 | Dim x As Integer |
0028 | Dim Y As String |
0029 | Dim z As String |
0030 | Dim z1 As String |
0031 | Dim z2 As String |
0032 | Dim strLetter As String |
0033 | Dim strLetter_Title As String |
0034 | Dim strControlBreak As String |
0035 | Dim strControlBreak_Last As String |
0036 | Dim strCol1Break As String |
0037 | Dim strCol1Break_Last As String |
0038 | Dim strLine_SavedHeader As String |
0039 | Dim strLine_SavedFooter As String |
0040 | Dim i As Integer |
0041 | Dim strLetter_Title_Short As String |
0042 | Dim strLetter_Title2 As String |
0043 | Dim Jump_type As Integer |
0044 | Dim File_Suffix As String |
0045 | Dim start As Date |
0046 | Dim strNextPageQuery As String |
0047 | Dim NextPage As String |
0048 | Dim NextPageID As String |
0049 | Dim LeftLink As String |
0050 | Dim RightLink As String |
0051 | Dim LinkTable As String |
0052 | Dim Toplink As String |
0053 | Dim MaxLen As Integer |
0054 | Dim Time_Stamp As String |
0055 | Dim RightPct As Integer |
0056 | Dim LeftPct As Integer |
0057 | Dim RightLen As Integer |
0058 | Dim LeftLen As Integer |
0059 | start = Now() |
0060 | Set fsoTextFile = New FileSystemObject |
0061 | 'Create Control File |
0062 | strFolder = strOutputFolder |
0063 | strFileName = strOutputFileShort & ".htm" |
0064 | Set tsTextFile = fsoTextFile.CreateTextFile(strFolder & strFileName, True, True) |
0065 | strLine_SavedHeader = "" |
0066 | 'Find Footer for BB Pages |
0067 | strLine_SavedFooter = "" |
0068 | 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;" |
0069 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0070 | rsTableControl.MoveFirst |
0071 | Do While Not rsTableControl.EOF |
0072 | strLine_SavedFooter = strLine_SavedFooter & rsTableControl.Fields(0) |
0073 | rsTableControl.MoveNext |
0074 | Loop |
0075 | OK = Replace_Timestamp(strLine_SavedFooter) |
0076 | 'Control Page Header |
0077 | If Main_Header = "Yes" Then |
0078 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""MainHeader"")) ORDER BY Website_Control.Line;" |
0079 | Else |
0080 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;" |
0081 | End If |
0082 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0083 | rsTableControl.MoveFirst |
0084 | Do While Not rsTableControl.EOF |
0085 | strLine = rsTableControl.Fields(0) & "" |
0086 | x = InStr(1, strLine, "**TITLE_HEAD**") |
0087 | If x > 0 Then |
0088 | strLine = Left(strLine, x - 1) & Mid(strLine, x + 15, Len(strLine)) |
0089 | End If |
0090 | x = InStr(1, strLine, "**SECTION**") |
0091 | If x > 0 Then |
0092 | 'Set up the "jump" table |
0093 | If strControlBreakType2 = "BB" Then |
0094 | strLine = "
" |
0095 | tsTextFile.WriteLine strLine |
0096 | 'Re-create the BB_Control table |
0097 | DoCmd.OpenQuery ("BB_Control_Zap") |
0098 | DoCmd.OpenQuery (strDataQuery & " (ControlGEN)") |
0099 | BB_Control_GEN |
0100 | 'Level 1 jump |
0101 | strControlQuery = "SELECT BB_Control.Level_5, Min(BB_Control.Primary_Break) AS MinOfPrimary_Break, Max(BB_Control.Primary_Break) AS MaxOfPrimary_Break FROM BB_Control GROUP BY BB_Control.Level_5;" |
0102 | Set rsTableToReadLetters = CurrentDb.OpenRecordset(strControlQuery) |
0103 | rsTableToReadLetters.MoveFirst |
0104 | strLine = "Level 1 Jump
" |
0105 | tsTextFile.WriteLine strLine |
0106 | Do While Not rsTableToReadLetters.EOF |
0107 | strLine = "" & rsTableToReadLetters.Fields(1) & " - " & rsTableToReadLetters.Fields(2) & " " |
0108 | tsTextFile.WriteLine strLine |
0109 | rsTableToReadLetters.MoveNext |
0110 | Loop |
0111 | strLine = strLine_SavedFooter |
0112 | tsTextFile.WriteLine strLine |
0113 | 'Level 2 jump |
0114 | rsTableToReadLetters.MoveFirst |
0115 | Do While Not rsTableToReadLetters.EOF |
0116 | Set tsJumpFile = fsoTextFile.CreateTextFile(strOutputFile & "_" & rsTableToReadLetters.Fields(0) & ".htm", True, True) |
0117 | strLine = strLine_SavedHeader & " Level 2 Jump
" |
0118 | tsJumpFile.WriteLine strLine |
0119 | strControlQuery = "SELECT BB_Control.Level_4, Min(BB_Control.Primary_Break) AS MinOfPrimary_Break, Max(BB_Control.Primary_Break) AS MaxOfPrimary_Break FROM BB_Control WHERE (((BB_Control.Level_5) = " & rsTableToReadLetters.Fields(0) & ")) GROUP BY BB_Control.Level_4;" |
0120 | Set rsTableToReadJump2 = CurrentDb.OpenRecordset(strControlQuery) |
0121 | rsTableToReadJump2.MoveFirst |
0122 | Do While Not rsTableToReadJump2.EOF |
0123 | strLine = "" & rsTableToReadJump2.Fields(1) & " - " & rsTableToReadJump2.Fields(2) & " " |
0124 | tsJumpFile.WriteLine strLine |
0125 | 'Level 3 Jump |
0126 | Set tsJumpFile2 = fsoTextFile.CreateTextFile(strOutputFile & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & ".htm", True, True) |
0127 | strLine = strLine_SavedHeader & " Level 3 Jump
" |
0128 | tsJumpFile2.WriteLine strLine |
0129 | strControlQuery = "SELECT BB_Control.Level_3, Min(BB_Control.Primary_Break) AS MinOfPrimary_Break, Max(BB_Control.Primary_Break) AS MaxOfPrimary_Break FROM BB_Control WHERE (((BB_Control.Level_5) = " & rsTableToReadLetters.Fields(0) & ")) GROUP BY BB_Control.Level_3, BB_Control.Level_4 HAVING (((BB_Control.Level_4)= " & rsTableToReadJump2.Fields(0) & "));" |
0130 | Set rsTableToReadJump3 = CurrentDb.OpenRecordset(strControlQuery) |
0131 | rsTableToReadJump3.MoveFirst |
0132 | Do While Not rsTableToReadJump3.EOF |
0133 | strLine = "" & rsTableToReadJump3.Fields(1) & " - " & rsTableToReadJump3.Fields(2) & " " |
0134 | tsJumpFile2.WriteLine strLine |
0135 | 'Level 4 Jump |
0136 | Set tsJumpFile3 = fsoTextFile.CreateTextFile(strOutputFile & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & ".htm", True, True) |
0137 | strLine = strLine_SavedHeader & " Level 4 Jump
" |
0138 | tsJumpFile3.WriteLine strLine |
0139 | strControlQuery = "SELECT BB_Control.Level_2, Min(BB_Control.Primary_Break) AS MinOfPrimary_Break, Max(BB_Control.Primary_Break) AS MaxOfPrimary_Break FROM BB_Control WHERE (((BB_Control.Level_3) = " & rsTableToReadJump3.Fields(0) & ") And ((BB_Control.Level_4) = " & rsTableToReadJump2.Fields(0) & ") And ((BB_Control.Level_5) = " & rsTableToReadLetters.Fields(0) & ")) GROUP BY BB_Control.Level_2;" |
0140 | Set rsTableToReadJump4 = CurrentDb.OpenRecordset(strControlQuery) |
0141 | rsTableToReadJump4.MoveFirst |
0142 | Do While Not rsTableToReadJump4.EOF |
0143 | strLine = "" & rsTableToReadJump4.Fields(1) & " - " & rsTableToReadJump4.Fields(2) & " " |
0144 | tsJumpFile3.WriteLine strLine |
0145 | rsTableToReadJump4.MoveNext |
0146 | Loop |
0147 | strLine = strLine_SavedFooter |
0148 | tsJumpFile3.WriteLine strLine |
0149 | OK = CopyToTransfer(strFolder, strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & ".htm") |
0150 | Set tsJumpFile3 = Nothing |
0151 | Set rsTableToReadJump4 = Nothing |
0152 | rsTableToReadJump3.MoveNext |
0153 | Loop |
0154 | strLine = strLine_SavedFooter |
0155 | tsJumpFile2.WriteLine strLine |
0156 | OK = CopyToTransfer(strFolder, strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & ".htm") |
0157 | Set tsJumpFile2 = Nothing |
0158 | Set rsTableToReadJump3 = Nothing |
0159 | rsTableToReadJump2.MoveNext |
0160 | Loop |
0161 | strLine = strLine_SavedFooter |
0162 | tsJumpFile.WriteLine strLine |
0163 | OK = CopyToTransfer(strFolder, strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & ".htm") |
0164 | rsTableToReadLetters.MoveNext |
0165 | Set tsJumpFile = Nothing |
0166 | Set rsTableToReadJump2 = Nothing |
0167 | Loop |
0168 | Set rsTableToReadLetters = Nothing |
0169 | Else |
0170 | If strControlBreakType = "Initial" Then 'Initial-letter jump table |
0171 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Jump_Table"") And ((Website_Control.Section) = ""All"")) ORDER BY Website_Control.Line;" |
0172 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0173 | rsTableControl2.MoveFirst |
0174 | Set rsTableToReadLetters = CurrentDb.OpenRecordset(strDataQuery & " (Letters)") |
0175 | If Not rsTableToReadLetters.EOF Then |
0176 | rsTableToReadLetters.MoveFirst |
0177 | strLetter = rsTableToReadLetters.Fields(0) |
0178 | Do While Not rsTableControl2.EOF |
0179 | strLine = rsTableControl2.Fields(0) & "" |
0180 | x = InStr(1, strLine, "**Column") |
0181 | If x > 0 Then |
0182 | Y = Mid(strLine, x + 8, 1) |
0183 | If Y < strLetter Then |
0184 | strLine = Left(strLine, x - 1) & "." & Mid(strLine, x + 11, Len(strLine)) |
0185 | Else |
0186 | If strSplitTable = "No" Then |
0187 | Y = "" & Y & "" |
0188 | Else |
0189 | Y = "" & Y & "" |
0190 | End If |
0191 | strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 11, Len(strLine)) |
0192 | If Not rsTableToReadLetters.EOF Then |
0193 | rsTableToReadLetters.MoveNext |
0194 | If Not rsTableToReadLetters.EOF Then |
0195 | strLetter = Left(rsTableToReadLetters.Fields(0), 1) |
0196 | Else |
0197 | strLetter = "ZZZ" |
0198 | End If |
0199 | End If |
0200 | End If |
0201 | tsTextFile.WriteLine strLine |
0202 | Else |
0203 | tsTextFile.WriteLine strLine |
0204 | End If |
0205 | rsTableControl2.MoveNext |
0206 | Loop |
0207 | End If |
0208 | Else |
0209 | 'Title-based jump table |
0210 | ' ... Header |
0211 | 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;" |
0212 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0213 | rsTableControl2.MoveFirst |
0214 | Do While Not rsTableControl2.EOF |
0215 | strLine = rsTableControl2.Fields(0) & "" |
0216 | tsTextFile.WriteLine strLine |
0217 | rsTableControl2.MoveNext |
0218 | Loop |
0219 | ' ... Rows |
0220 | 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;" |
0221 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0222 | rsTableControl2.MoveFirst |
0223 | If strControlBreakType2 = "2-Level" Then |
0224 | Set rsTableToReadLetters = CurrentDb.OpenRecordset(strDataQuery & " (Titles) - Top") |
0225 | Else |
0226 | Set rsTableToReadLetters = CurrentDb.OpenRecordset(strDataQuery & " (Titles)") |
0227 | End If |
0228 | rsTableToReadLetters.MoveFirst |
0229 | z = rsTableToReadLetters.Fields(0).Name |
0230 | z1 = rsTableToReadLetters.Fields(1).Name |
0231 | strLetter = rsTableToReadLetters.Fields(1) 'Note: this is the internal ID of the field |
0232 | strLetter_Title = rsTableToReadLetters.Fields(0) |
0233 | Do While (Not rsTableControl2.EOF Or Not rsTableToReadLetters.EOF) |
0234 | If rsTableControl2.EOF Then |
0235 | rsTableControl2.MoveFirst |
0236 | End If |
0237 | If strSplitTable = "No" Then |
0238 | Else |
0239 | Jump_type = 1 |
0240 | If rsTableToReadLetters.Fields.Count > 2 Then |
0241 | If Not rsTableToReadLetters.EOF Then |
0242 | If rsTableToReadLetters.Fields(2) = 1 Then |
0243 | Jump_type = 1 |
0244 | Else |
0245 | Jump_type = 2 |
0246 | End If |
0247 | End If |
0248 | End If |
0249 | End If |
0250 | strLine = rsTableControl2.Fields(0) & "" |
0251 | x = InStr(1, strLine, "**Column") |
0252 | If x > 0 Then |
0253 | If strLetter <> "" Then |
0254 | If strSplitTable = "No" Then |
0255 | If InStr(strLetter_Title, " ") > 0 Then |
0256 | strLetter_Title_Short = Left(strLetter_Title, InStr(strLetter_Title, " ") - 1) |
0257 | Else |
0258 | strLetter_Title_Short = strLetter_Title |
0259 | End If |
0260 | Y = "" & strLetter_Title & "" |
0261 | Else |
0262 | If strControlBreakType2 = "2-Level" Then |
0263 | If Jump_type = 2 Then |
0264 | Y = "" & strLetter_Title & "" |
0265 | Else |
0266 | File_Suffix = strLetter |
0267 | Y = "" & strLetter_Title & "" |
0268 | End If |
0269 | Else |
0270 | Y = "" & strLetter_Title & "" |
0271 | End If |
0272 | End If |
0273 | Else |
0274 | Y = "." |
0275 | End If |
0276 | strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 10, Len(strLine)) |
0277 | If Not rsTableToReadLetters.EOF Then |
0278 | rsTableToReadLetters.MoveNext |
0279 | If Not rsTableToReadLetters.EOF Then |
0280 | strLetter = rsTableToReadLetters.Fields(1) |
0281 | strLetter_Title = rsTableToReadLetters.Fields(0) |
0282 | If strControlBreakType2 = "2-Level" Then |
0283 | If rsTableToReadLetters.Fields(2) = 1 Then |
0284 | Jump_type = 1 |
0285 | Else |
0286 | Jump_type = 2 |
0287 | End If |
0288 | End If |
0289 | Else |
0290 | strLetter = "" |
0291 | End If |
0292 | End If |
0293 | tsTextFile.WriteLine strLine |
0294 | Else |
0295 | tsTextFile.WriteLine strLine |
0296 | End If |
0297 | rsTableControl2.MoveNext |
0298 | Loop |
0299 | ' ... Footer |
0300 | 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;" |
0301 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0302 | rsTableControl2.MoveFirst |
0303 | Do While Not rsTableControl2.EOF |
0304 | strLine = rsTableControl2.Fields(0) & "" |
0305 | tsTextFile.WriteLine strLine |
0306 | rsTableControl2.MoveNext |
0307 | Loop |
0308 | If strControlBreakType2 = "2-Level" Then |
0309 | 'Add a second-level set of Jump tables if necessary |
0310 | Set rsTableToReadJump4 = CurrentDb.OpenRecordset(strDataQuery & " (Titles) - Top") |
0311 | rsTableToReadJump4.MoveFirst |
0312 | Do While Not rsTableToReadJump4.EOF |
0313 | If rsTableToReadJump4.Fields(2) > 1 Then |
0314 | strLetter_Title2 = rsTableToReadJump4.Fields(1) |
0315 | strLetter_Title_Short = Left(rsTableToReadJump4.Fields(0), InStr(rsTableToReadJump4.Fields(0), " ") - 1) |
0316 | Set tsJumpFile = fsoTextFile.CreateTextFile(strOutputFile & "_Top_" & strLetter_Title2 & ".htm", True, True) |
0317 | 'Page Header |
0318 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;" |
0319 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0320 | rsTableControl2.MoveFirst |
0321 | Do While Not rsTableControl2.EOF |
0322 | strLine = rsTableControl2.Fields(0) & "" |
0323 | x = InStr(1, strLine, "**TITLE_HEAD**") |
0324 | If x > 0 Then |
0325 | strLine = Left(strLine, x - 1) & rsTableToReadJump4.Fields(0) & " - " & Mid(strLine, x + 15, Len(strLine)) |
0326 | strLine = Replace(strLine, " ", " ") |
0327 | End If |
0328 | x = InStr(1, strLine, "**SECTION**") |
0329 | If x > 0 Then |
0330 | strLine = Left(strLine, x - 1) & ": " & rsTableToReadJump4.Fields(0) & Mid(strLine, x + 11, Len(strLine)) |
0331 | 'Find Next page |
0332 | strNextPageQuery = "SELECT [" & strDataQuery & " (Titles) - Top].* FROM [" & strDataQuery & " (Titles) - Top];" |
0333 | Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery) |
0334 | rsTableControl3.MoveFirst |
0335 | z = rsTableControl3.Fields(0).Name |
0336 | z1 = rsTableControl3.Fields(1).Name |
0337 | z2 = rsTableControl3.Fields(2).Name |
0338 | strNextPageQuery = "SELECT [" & strDataQuery & " (Titles) - Top].[" & z & "], [" & strDataQuery & " (Titles) - Top].[" & z1 & "], [" & strDataQuery & " (Titles) - Top].[" & z2 & "] FROM [" & strDataQuery & " (Titles) - Top] WHERE ((([" & strDataQuery & " (Titles) - Top].[" & z & "])>""" & rsTableToReadJump4.Fields(0).Value & """)) ORDER BY [" & strDataQuery & " (Titles) - Top].[" & z & "];" |
0339 | Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery) |
0340 | If rsTableControl3.EOF Then |
0341 | NextPage = "" |
0342 | NextPageID = "" |
0343 | Else |
0344 | rsTableControl3.MoveFirst |
0345 | NextPage = rsTableControl3.Fields(0) |
0346 | NextPage = Left(NextPage, InStr(NextPage, "<") - 1) |
0347 | NextPageID = rsTableControl3.Fields(1) |
0348 | If rsTableControl3.Fields(2) = 1 Then |
0349 | NextPageID = NextPageID |
0350 | Else |
0351 | NextPageID = "Top_" & NextPageID |
0352 | End If |
0353 | End If |
0354 | LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: " & strFileTitle_Previous & "") |
0355 | LeftLen = IIf(strFileSuffix_Previous = "", Len("Previous Page: None"), Len("Previous Page: " & strFileTitle_Previous)) |
0356 | RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: " & NextPage & "") |
0357 | RightLen = IIf(NextPage = "", Len("Next Page: None"), Len("Next Page: " & NextPage)) |
0358 | If LeftLen > RightLen Then |
0359 | MaxLen = LeftLen |
0360 | Else |
0361 | MaxLen = RightLen |
0362 | End If |
0363 | MaxLen = 200 + 15 * MaxLen |
0364 | If MaxLen > 950 Then |
0365 | LeftPct = Round((LeftLen + 100 / 8) / (LeftLen + RightLen + 200 / 8) * 100, 0) |
0366 | RightPct = 100 - LeftPct |
0367 | MaxLen = 200 + (LeftLen + RightLen) * 8 |
0368 | Else |
0369 | LeftPct = 50 |
0370 | RightPct = 50 |
0371 | End If |
0372 | LinkTable = "" |
0373 | strLine = strLine & LinkTable |
0374 | strFileSuffix_Previous = strLetter_Title2 |
0375 | strFileTitle_Previous = rsTableToReadJump4.Fields(0) |
0376 | strFileTitle_Previous = Left(strFileTitle_Previous, InStr(strFileTitle_Previous, "<") - 1) |
0377 | End If |
0378 | tsJumpFile.WriteLine strLine |
0379 | rsTableControl2.MoveNext |
0380 | Loop |
0381 | ' ... Header |
0382 | 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;" |
0383 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0384 | rsTableControl2.MoveFirst |
0385 | Do While Not rsTableControl2.EOF |
0386 | strLine = rsTableControl2.Fields(0) & "" |
0387 | tsJumpFile.WriteLine strLine |
0388 | rsTableControl2.MoveNext |
0389 | Loop |
0390 | ' ... Rows |
0391 | 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;" |
0392 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0393 | rsTableControl2.MoveFirst |
0394 | strQuery = strDataQuery & " (Titles)" |
0395 | strQuery = "SELECT [" & strQuery & "].Category, [" & strQuery & "].ID FROM [" & strQuery & "] WHERE ((([" & strQuery & "].Top_ID) = """ & strLetter_Title2 & """)) ORDER BY [" & strQuery & "].Category;" |
0396 | Set rsTableToReadLetters = CurrentDb.OpenRecordset(strQuery) |
0397 | If Not rsTableToReadLetters.EOF Then 'This is a fudge for "Music Music" (202_35) and maybe others. |
0398 | rsTableToReadLetters.MoveFirst |
0399 | strLetter = rsTableToReadLetters.Fields(1) 'Note: this is the internal ID of the field |
0400 | strLetter_Title = rsTableToReadLetters.Fields(0) |
0401 | End If |
0402 | Do While (Not rsTableControl2.EOF Or Not rsTableToReadLetters.EOF) |
0403 | If rsTableControl2.EOF Then |
0404 | rsTableControl2.MoveFirst |
0405 | End If |
0406 | strLine = rsTableControl2.Fields(0) & "" |
0407 | x = InStr(1, strLine, "**Column") |
0408 | If x > 0 Then |
0409 | If strLetter <> "" Then |
0410 | If strSplitTable = "No" Then |
0411 | If InStr(strLetter_Title, " ") > 0 Then |
0412 | strLetter_Title_Short = Left(strLetter_Title, InStr(strLetter_Title, " ") - 1) |
0413 | Else |
0414 | strLetter_Title_Short = strLetter_Title |
0415 | End If |
0416 | Y = "" & strLetter_Title & "" |
0417 | Else |
0418 | If strControlBreakType2 = "2-Level" Then |
0419 | Y = "" & strLetter_Title & "" |
0420 | Else |
0421 | Y = "" & strLetter_Title & "" |
0422 | End If |
0423 | End If |
0424 | Else |
0425 | Y = "." |
0426 | End If |
0427 | strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 10, Len(strLine)) |
0428 | If Not rsTableToReadLetters.EOF Then |
0429 | rsTableToReadLetters.MoveNext |
0430 | If Not rsTableToReadLetters.EOF Then |
0431 | strLetter = rsTableToReadLetters.Fields(1) |
0432 | strLetter_Title = rsTableToReadLetters.Fields(0) |
0433 | Else |
0434 | strLetter = "" |
0435 | End If |
0436 | End If |
0437 | tsJumpFile.WriteLine strLine |
0438 | Else |
0439 | tsJumpFile.WriteLine strLine |
0440 | End If |
0441 | rsTableControl2.MoveNext |
0442 | Loop |
0443 | ' ... Footer |
0444 | 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;" |
0445 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0446 | rsTableControl2.MoveFirst |
0447 | Do While Not rsTableControl2.EOF |
0448 | strLine = rsTableControl2.Fields(0) & "" |
0449 | tsJumpFile.WriteLine strLine |
0450 | rsTableControl2.MoveNext |
0451 | Loop |
0452 | tsJumpFile.WriteLine "" |
0453 | 'Page Footer |
0454 | 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;" |
0455 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0456 | rsTableControl2.MoveFirst |
0457 | Do While Not rsTableControl2.EOF |
0458 | Time_Stamp = rsTableControl2.Fields(0) |
0459 | OK = Replace_Timestamp(Time_Stamp) |
0460 | tsJumpFile.WriteLine Time_Stamp |
0461 | rsTableControl2.MoveNext |
0462 | Loop |
0463 | 'Copy page to Transfer directory |
0464 | OK = CopyToTransfer(strFolder, strOutputFileShort & "_Top_" & strLetter_Title2 & ".htm") |
0465 | Set tsJumpFile = Nothing |
0466 | End If |
0467 | rsTableToReadJump4.MoveNext |
0468 | Loop |
0469 | End If |
0470 | End If |
0471 | End If |
0472 | Else |
0473 | OK = Replace_Timestamp(strLine) |
0474 | strLine_SavedHeader = strLine_SavedHeader & rsTableControl.Fields(0) |
0475 | tsTextFile.WriteLine strLine |
0476 | End If |
0477 | rsTableControl.MoveNext |
0478 | Loop |
0479 | DataRead: |
0480 | 'Read the data |
0481 | Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery) |
0482 | iIDCol = rsTableToRead.Fields.Count 'Log the last column number (which contains the record ID) |
0483 | If Not rsTableToRead.EOF Then |
0484 | rsTableToRead.MoveFirst |
0485 | strControlBreak = Left(rsTableToRead.Fields(0) & "", 1) |
0486 | iTableColumns = rsTableToRead.Fields.Count |
0487 | End If |
0488 | 'Force a control-break |
0489 | strControlBreak_Last = "@" |
0490 | strFileSuffix = "" |
0491 | strFileTitle = "" |
0492 | If strSplitTable = "No" Then 'This is for tables that don't split across web-pages, so have intermediate control breaks |
0493 | 'Read Table-Control for rows |
0494 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Table_Row"")) ORDER BY Website_Control.Line;" |
0495 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0496 | If strControlBreakType = "xInitial" Then 'This has been disabled ... remove if proved not to be needed |
0497 | 'Table Column Headings |
0498 | rsTableControl.MoveFirst |
0499 | Do While Not rsTableControl.EOF |
0500 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0501 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0502 | If iFieldNo > 0 And iFieldNo <= iTableColumns Then |
0503 | tsTextFile.WriteLine " " & rsTableToRead.Fields(iFieldNo - 1).Name & "" |
0504 | End If |
0505 | Else |
0506 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0507 | End If |
0508 | rsTableControl.MoveNext |
0509 | Loop |
0510 | End If |
0511 | End If |
0512 | z = rsTableToRead.Fields(0).Name |
0513 | If Not rsTableToRead.EOF Then |
0514 | z1 = rsTableToRead.Fields(iTableColumns - 2).Name |
0515 | End If |
0516 | Do Until rsTableToRead.EOF |
0517 | strFileSuffix_Previous = strFileSuffix |
0518 | strFileTitle_Previous = strFileTitle |
0519 | If strControlBreakType2 = "BB" Then |
0520 | strFileSuffix = "_" & rsTableToRead.Fields(2) & "" |
0521 | Else |
0522 | If strSplitTable = "No" Then |
0523 | strFileSuffix = "" |
0524 | Else |
0525 | If strControlBreakType = "Initial" Then |
0526 | strFileSuffix = "_" & UCase(Left(rsTableToRead.Fields(0) & "", 1)) |
0527 | Else |
0528 | strFileSuffix = "_" & rsTableToRead.Fields(iTableColumns - 2) & "" |
0529 | strFileTitle = rsTableToRead.Fields(0) & "" |
0530 | End If |
0531 | End If |
0532 | End If |
0533 | If strFileSuffix_Previous <> strFileSuffix Then |
0534 | 'Write the previous Footer |
0535 | If strFileSuffix_Previous <> "" Then |
0536 | 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;" |
0537 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0538 | rsTableControl.MoveFirst |
0539 | Do While Not rsTableControl.EOF |
0540 | Time_Stamp = rsTableControl.Fields(0) & "" |
0541 | OK = Replace_Timestamp(Time_Stamp) |
0542 | tsTextFile.WriteLine Time_Stamp |
0543 | rsTableControl.MoveNext |
0544 | Loop |
0545 | OK = CopyToTransfer(strFolder, strOutputFileShort & strFileSuffix_Previous & ".htm") |
0546 | End If |
0547 | 'Create File |
0548 | Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFile & strFileSuffix & ".htm", True, True) |
0549 | 'Page Header |
0550 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;" |
0551 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0552 | rsTableControl.MoveFirst |
0553 | Do While Not rsTableControl.EOF |
0554 | strLine = rsTableControl.Fields(0) & "" |
0555 | x = InStr(1, strLine, "**TITLE_HEAD**") |
0556 | If x > 0 Then |
0557 | If strControlBreakType2 = "BB" Then |
0558 | strLine = Left(strLine, x - 1) & "Section: " & rsTableToRead.Fields(3) & " - " & Mid(strLine, x + 14, Len(strLine)) |
0559 | Else |
0560 | If strSplitTable = "No" Then |
0561 | strLine = Left(strLine, x - 1) & Mid(strLine, x + 15, Len(strLine)) |
0562 | Else |
0563 | If strControlBreakType = "Initial" Then |
0564 | strLine = Left(strLine, x - 1) & "Section: " & Right(strFileSuffix, 1) & " - " & Mid(strLine, x + 14, Len(strLine)) |
0565 | Else |
0566 | strLine = Left(strLine, x - 1) & "Section: " & rsTableToRead.Fields(0) & " - " & Mid(strLine, x + 14, Len(strLine)) |
0567 | End If |
0568 | End If |
0569 | End If |
0570 | End If |
0571 | x = InStr(1, strLine, "**SECTION**") |
0572 | If x > 0 Then |
0573 | If strControlBreakType2 = "BB" Then |
0574 | strLine = Left(strLine, x - 1) & rsTableToRead.Fields(3) & Mid(strLine, x + 11, Len(strLine)) |
0575 | Else |
0576 | If strSplitTable = "No" Then |
0577 | strLine = Left(strLine, x - 1) & "A-Z" & Mid(strLine, x + 11, Len(strLine)) |
0578 | Else |
0579 | If strControlBreakType = "Initial" Then |
0580 | strLine = Left(strLine, x - 1) & Right(strFileSuffix, 1) & Mid(strLine, x + 11, Len(strLine)) |
0581 | 'Find Next page |
0582 | strNextPageQuery = "SELECT [" & strDataQuery & " (Letters)].* FROM [" & strDataQuery & " (Letters)];" |
0583 | Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery) |
0584 | rsTableControl3.MoveFirst |
0585 | z = rsTableControl3.Fields(0).Name |
0586 | strNextPageQuery = "SELECT [" & strDataQuery & " (Letters)].[" & z & "] FROM [" & strDataQuery & " (Letters)] WHERE ((([" & strDataQuery & " (Letters)].[" & z & "])>""" & rsTableToRead.Fields(0).Value & """)) ORDER BY [" & strDataQuery & " (Letters)].[" & z & "];" |
0587 | Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery) |
0588 | If rsTableControl3.EOF Then |
0589 | NextPage = "" |
0590 | NextPageID = "" |
0591 | Else |
0592 | rsTableControl3.MoveFirst |
0593 | NextPage = rsTableControl3.Fields(0) |
0594 | End If |
0595 | LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: " & Right(strFileSuffix_Previous, 1) & "") |
0596 | RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: " & NextPage & "") |
0597 | LinkTable = "" |
0598 | strLine = strLine & LinkTable |
0599 | Else |
0600 | strLine = Left(strLine, x - 1) & ": " & rsTableToRead.Fields(0) & Mid(strLine, x + 11, Len(strLine)) |
0601 | 'Find Next page |
0602 | strNextPageQuery = "SELECT [" & strDataQuery & "].[" & z & "], [" & strDataQuery & "].[" & z1 & "] FROM [" & strDataQuery & "] WHERE ((([" & strDataQuery & "].[" & z & "])>""" & rsTableToRead.Fields(0).Value & """)) ORDER BY [" & strDataQuery & "].[" & z & "];" |
0603 | Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery) |
0604 | If rsTableControl3.EOF Then |
0605 | NextPage = "" |
0606 | NextPageID = "" |
0607 | Else |
0608 | rsTableControl3.MoveFirst |
0609 | NextPage = rsTableControl3.Fields(0) |
0610 | NextPageID = rsTableControl3.Fields(1) |
0611 | End If |
0612 | LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: " & strFileTitle_Previous & "") |
0613 | LeftLen = IIf(strFileSuffix_Previous = "", Len("Previous Page: None"), Len("Previous Page: " & strFileTitle_Previous)) |
0614 | RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: " & NextPage & "") |
0615 | RightLen = IIf(NextPage = "", Len("Next Page: None"), Len("Next Page: " & NextPage)) |
0616 | If LeftLen > RightLen Then |
0617 | MaxLen = LeftLen |
0618 | Else |
0619 | MaxLen = RightLen |
0620 | End If |
0621 | MaxLen = 200 + 15 * MaxLen |
0622 | If MaxLen > 950 Then |
0623 | LeftPct = Round((LeftLen + 100 / 8) / (LeftLen + RightLen + 200 / 8) * 100, 0) |
0624 | RightPct = 100 - LeftPct |
0625 | MaxLen = 200 + (LeftLen + RightLen) * 8 |
0626 | Else |
0627 | LeftPct = 50 |
0628 | RightPct = 50 |
0629 | End If |
0630 | 'Find next level up (if there is one) |
0631 | If InStr(2, strFileSuffix, "_") > 0 Then |
0632 | If InStr(rsTableToRead.Fields(0), " - ") > 0 Then |
0633 | Toplink = "Next Level Up: " & Left(rsTableToRead.Fields(0), InStr(rsTableToRead.Fields(0), " - ") - 1) & " | " |
0634 | Else |
0635 | Toplink = "Next Level Up: " & rsTableToRead.Fields(0) & " | " |
0636 | End If |
0637 | 'Check for solitons |
0638 | On Error Resume Next |
0639 | strNextPageQuery = "SELECT [" & strDataQuery & " (Titles) - Solitons].[ID] FROM [" & strDataQuery & " (Titles) - Solitons] WHERE ((([" & strDataQuery & " (Titles) - Solitons].[ID])=""" & Mid(strFileSuffix, 2, 100) & """));" |
0640 | Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery) |
0641 | If rsTableControl3.EOF Then |
0642 | Else |
0643 | Toplink = "" |
0644 | End If |
0645 | On Error GoTo 0 |
0646 | Else |
0647 | Toplink = "" |
0648 | End If |
0649 | LinkTable = "" |
0650 | strLine = strLine & LinkTable |
0651 | End If |
0652 | End If |
0653 | End If |
0654 | End If |
0655 | tsTextFile.WriteLine strLine |
0656 | rsTableControl.MoveNext |
0657 | Loop |
0658 | 'Read Table-Control for rows |
0659 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Table_Row"")) ORDER BY Website_Control.Line;" |
0660 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0661 | If strControlBreakType2 = "BB" Then |
0662 | 'Write out the 2nd Jump List |
0663 | strControlQuery = "SELECT [" & strDataQuery & " (Breaks)].Break FROM [" & strDataQuery & " (Breaks)] WHERE ((([" & strDataQuery & " (Breaks)].Suffix)=""" & Mid(strFileSuffix, 2, Len(strFileSuffix)) & """));" |
0664 | Set rsTableControl_BB = CurrentDb.OpenRecordset(strControlQuery) |
0665 | If Not rsTableControl_BB.EOF Then |
0666 | rsTableControl_BB.MoveFirst |
0667 | Do While Not rsTableControl_BB.EOF |
0668 | tsTextFile.WriteLine "" & rsTableControl_BB.Fields(0) & " " |
0669 | rsTableControl_BB.MoveNext |
0670 | Loop |
0671 | tsTextFile.WriteLine "
" |
0672 | strCol1Break_Last = "" |
0673 | i = 1 |
0674 | tsTextFile.WriteLine " " |
0675 | End If |
0676 | Else |
0677 | 'Table Column Headings |
0678 | rsTableControl.MoveFirst |
0679 | Do While Not rsTableControl.EOF |
0680 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0681 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0682 | If iFieldNo > 0 And iFieldNo <= iTableColumns Then |
0683 | tsTextFile.WriteLine " " & rsTableToRead.Fields(iFieldNo - 1).Name & "" |
0684 | End If |
0685 | Else |
0686 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0687 | End If |
0688 | rsTableControl.MoveNext |
0689 | Loop |
0690 | End If |
0691 | End If |
0692 | 'Internal Control Breaks |
0693 | If strControlBreakType = "Initial" Then |
0694 | strControlBreak = Left(rsTableToRead.Fields(0), 1) |
0695 | Else |
0696 | strControlBreak = Replace(rsTableToRead.Fields(0) & "", " ", "_") |
0697 | End If |
0698 | If strControlBreak_Last <> strControlBreak Then |
0699 | If strSplitTable = "No" Then |
0700 | 'Add an internal table break + reference |
0701 | tsTextFile.WriteLine " |
"
0702 | 'Table Column Headings |
0703 | rsTableControl.MoveFirst |
0704 | Do While Not rsTableControl.EOF |
0705 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0706 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0707 | If iFieldNo > 0 And iFieldNo <= iTableColumns Then |
0708 | tsTextFile.WriteLine " " & rsTableToRead.Fields(iFieldNo - 1).Name & "" |
0709 | End If |
0710 | Else |
0711 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0712 | End If |
0713 | rsTableControl.MoveNext |
0714 | Loop |
0715 | End If |
0716 | strControlBreak_Last = strControlBreak |
0717 | End If |
0718 | 'Table Row |
0719 | rsTableControl.MoveFirst |
0720 | Do While Not rsTableControl.EOF |
0721 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0722 | If strControlBreakType2 = "BB" Then |
0723 | strCol1Break = rsTableToRead.Fields(0) |
0724 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0725 | If iFieldNo > 0 And iFieldNo <= iTableColumns Then |
0726 | If iFieldNo = 1 Then |
0727 | If strCol1Break <> strCol1Break_Last Then |
0728 | strLine = " " & strCol1Break & " " |
0729 | tsTextFile.WriteLine strLine |
0730 | i = 1 |
0731 | End If |
0732 | Else |
0733 | If Left(strControlTable, 4) = "Book" Then |
0734 | strLine = i & ". " & rsTableToRead.Fields(iFieldNo - 1) & IIf(iFieldNo < iTableColumns, IIf(rsTableToRead.Fields(iTableColumns - 1) > 0, " (More)", ""), "") & " " |
0735 | Else |
0736 | strLine = i & ". " & rsTableToRead.Fields(iFieldNo - 1) & IIf(iFieldNo < iTableColumns, IIf(rsTableToRead.Fields(iTableColumns - 1) > 0, " (Abstract)", ""), "") & " ... More " |
0737 | End If |
0738 | tsTextFile.WriteLine strLine |
0739 | End If |
0740 | End If |
0741 | Else |
0742 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0743 | If iFieldNo > 0 And iFieldNo <= iTableColumns Then |
0744 | If Len(rsTableToRead.Fields(iFieldNo - 1) & "") = 0 Then |
0745 | tsTextFile.WriteLine " " |
0746 | Else |
0747 | If rsTableToRead.Fields(iFieldNo - 1).Name = "Abstract" Then |
0748 | 'Generate Paper Sumary & Abstract Links |
0749 | strLine = PaperSumaryAbstract_Links(rsTableToRead.Fields(iFieldNo - 1).Value, rsTableToRead.Fields(iIDCol - 1)) |
0750 | Else |
0751 | strLine = rsTableToRead.Fields(iFieldNo - 1) |
0752 | If rsTableToRead.Fields(iFieldNo - 1).Name = "Source" Then |
0753 | strLine = Remove_Dummy_Ref(strLine) |
0754 | strLine = WebEncode(strLine) |
0755 | OK = Reference_Books(strLine, "X", 0, 0, 0) |
0756 | OK = Reference_Papers(strLine, "X", 0, 0, 0) |
0757 | OK = Reference_Webrefs(strLine, "X", 0, 0) |
0758 | Else |
0759 | If rsTableToRead.Fields(iFieldNo - 1).Name = "Link" Then |
0760 | If strLine = "**Precis**" Then 'Comments that were null, or (most likely) contained part of the precis |
0761 | strLine = "" |
0762 | Else |
0763 | strLine = Replace(strLine, "../", "") |
0764 | End If |
0765 | strLine = Remove_Dummy_Ref(strLine) |
0766 | strLine = WebEncode(strLine) |
0767 | OK = Reference_Books(strLine, "X", 0, 0, 0) |
0768 | OK = Reference_Papers(strLine, "X", 0, 0, 0) |
0769 | OK = Reference_Notes(strLine, "X", 0, 0, 0) |
0770 | OK = Reference_Notes(strLine, "X", 0, 0, 0, "Abstract_Direct") |
0771 | OK = Reference_Webrefs(strLine, "X", 0, 0) |
0772 | strLine = NumberedBullets(strLine) |
0773 | strLine = Bullets(strLine) |
0774 | tsTextFile.WriteLine "" & "Summary" & ", Abstract " |
0775 | If Len(strLine) > 500 Then |
0776 | strLine = "Précis link too long - follow above link to Abstract" |
0777 | End If |
0778 | Else |
0779 | If rsTableToRead.Fields(iFieldNo - 1).Name = "Author" Then |
0780 | OK = Author_Reference_String(strLine, 0) |
0781 | End If |
0782 | End If |
0783 | End If |
0784 | End If |
0785 | strLine = Replace(strLine, Chr(13) & Chr(10), " ") |
0786 | tsTextFile.WriteLine strLine |
0787 | End If |
0788 | End If |
0789 | End If |
0790 | Else |
0791 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0792 | End If |
0793 | rsTableControl.MoveNext |
0794 | Loop |
0795 | rsTableToRead.MoveNext |
0796 | strCol1Break_Last = strCol1Break |
0797 | i = i + 1 |
0798 | Loop |
0799 | 'Final Page Footer |
0800 | 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;" |
0801 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0802 | rsTableControl.MoveFirst |
0803 | Do While Not rsTableControl.EOF |
0804 | Time_Stamp = rsTableControl.Fields(0) & "" |
0805 | OK = Replace_Timestamp(Time_Stamp) |
0806 | tsTextFile.WriteLine Time_Stamp |
0807 | rsTableControl.MoveNext |
0808 | Loop |
0809 | TheEnd: |
0810 | 'Copy page to Transfer directory |
0811 | OK = CopyToTransfer(strFolder, strFileName) |
0812 | OK = CopyToTransfer(strFolder, strOutputFileShort & strFileSuffix & ".htm") |
0813 | 'Clearout |
0814 | Set tsTextFile = Nothing |
0815 | Set fsoTextFile = Nothing |
0816 | Set tsTextFile = Nothing |
0817 | Set tsJumpFile2 = Nothing |
0818 | Set tsJumpFile3 = Nothing |
0819 | Set rsAbstractQuality = Nothing |
0820 | Set rsTableToRead = Nothing |
0821 | Set rsTableToReadLetters = Nothing |
0822 | Set rsTableToReadJump2 = Nothing |
0823 | Set rsTableToReadJump3 = Nothing |
0824 | Set rsTableToReadJump4 = Nothing |
0825 | Set rsTableControl = Nothing |
0826 | Set rsTableControl2 = Nothing |
0827 | Set rsTableControl3 = Nothing |
0828 | Set rsTableControl_BB = Nothing |
0829 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub JumpTableTitles(Optional Run_Type) |
0002 | Dim strControlQuery As String |
0003 | Dim rsTableControl2 As Recordset |
0004 | Dim rsTableToReadLetters As Recordset |
0005 | Dim rsMasterNote As Recordset |
0006 | Dim strLetter As String |
0007 | Dim strLetter_Title As String |
0008 | Dim strLine As String |
0009 | Dim x As Integer |
0010 | Dim Y As String |
0011 | Dim fsoTextFile As FileSystemObject |
0012 | Dim Title_Loc As Integer |
0013 | Dim strQuery As String |
0014 | Dim Note_Subdirectory As String |
0015 | Dim i As Long |
0016 | Dim Add_Colours As Boolean |
0017 | Dim strColour |
0018 | If IsMissing(Run_Type) Then |
0019 | Set fsoTextFile = New FileSystemObject |
0020 | Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFile & ".htm", True, True) |
0021 | End If |
0022 | 'Title-based jump table |
0023 | ' ... Header |
0024 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;" |
0025 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0026 | rsTableControl2.MoveFirst |
0027 | Do While Not rsTableControl2.EOF |
0028 | strLine = rsTableControl2.Fields(0) & "" |
0029 | Title_Loc = InStr(strLine, "**TITLE**") |
0030 | If Title_Loc > 0 Then |
0031 | strLine = Left(strLine, Title_Loc - 1) & Notes_Group & Mid(strLine, Title_Loc + 9, Len(strLine)) |
0032 | If Notes_Group_Narrative & "" <> "" Then |
0033 | strLine = strLine & " Note-Group Purpose: " & Notes_Group_Narrative & " " |
0034 | End If |
0035 | strLine = strLine & " Click here for the explanation of the colouration in the table below. " |
0036 | End If |
0037 | tsTextFile.WriteLine strLine |
0038 | rsTableControl2.MoveNext |
0039 | Loop |
0040 | Add_Colours = True 'This flag was for testing ... or maybe subsequent exclusions |
0041 | ' ... Rows |
0042 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Rows"")) ORDER BY Website_Control.Line;" |
0043 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0044 | rsTableControl2.MoveFirst |
0045 | If Notes_Recent > 0 Then |
0046 | 'This simple sum decoupled because of weird numeric overflow problems. |
0047 | i = -Notes_Recent |
0048 | i = i * 1000 |
0049 | i = i + Last_Changed_Timestamp |
0050 | strQuery = strDataQuery & " (Titles)_All" |
0051 | strQuery = "SELECT [" & strQuery & "].Item_Title, [" & strQuery & "].ID, [" & strQuery & "].Note_Quality_Text, [" & strQuery & "].Note_Quality_Colour FROM [" & strQuery & "] WHERE ((([" & strQuery & "].Last_Changed) > " & i & ") AND (([" & strQuery & "].Note_Group) = " & Notes_Group_ID & ")) ORDER BY [" & strQuery & "].Item_Title;" |
0052 | Else |
0053 | strQuery = strDataQuery & " (Titles)" |
0054 | strQuery = "SELECT [" & strQuery & "].Item_Title, [" & strQuery & "].ID, [" & strQuery & "].Note_Quality_Text, [" & strQuery & "].Note_Quality_Colour FROM [" & strQuery & "] WHERE ((([" & strQuery & "].Note_Group) = " & Notes_Group_ID & ")) ORDER BY [" & strQuery & "].Item_Title;" |
0055 | End If |
0056 | Set rsTableToReadLetters = CurrentDb.OpenRecordset(strQuery) |
0057 | If Not rsTableToReadLetters.EOF Then |
0058 | rsTableToReadLetters.MoveFirst |
0059 | End If |
0060 | If Not rsTableToReadLetters.EOF Then |
0061 | strLetter = rsTableToReadLetters.Fields(1) 'Note: this is the internal ID of the field |
0062 | strLetter_Title = rsTableToReadLetters.Fields(0) |
0063 | If Notes_Recent > 0 Then |
0064 | 'Find the Master-Note |
0065 | Set rsMasterNote = CurrentDb.OpenRecordset("SELECT Notes.Item_Title, Notes.Note_Group FROM Notes INNER JOIN Master_Notes ON Notes.ID = Master_Notes.Top_Master_Note WHERE (((Master_Notes.ID)=" & strLetter & "));") |
0066 | If Not rsMasterNote.EOF Then |
0067 | rsMasterNote.MoveFirst |
0068 | If rsMasterNote.Fields(1).Value = 5 Then 'For Blog, prefix the Master Note ... |
0069 | If strLetter_Title <> rsMasterNote.Fields(0).Value Then |
0070 | strLetter_Title = strLetter_Title & " (" & rsMasterNote.Fields(0).Value & ")" |
0071 | End If |
0072 | End If |
0073 | End If |
0074 | Set rsMasterNote = Nothing |
0075 | End If |
0076 | Do While (Not rsTableControl2.EOF Or Not rsTableToReadLetters.EOF) |
0077 | If rsTableControl2.EOF Then |
0078 | rsTableControl2.MoveFirst |
0079 | End If |
0080 | strLine = rsTableControl2.Fields(0) & "" |
0081 | strColour = "" |
0082 | If Add_Colours = True Then |
0083 | If InStr(strLine, " **Colour**") > 0 Then |
0084 | If Not rsTableToReadLetters.EOF Then |
0085 | strColour = rsTableToReadLetters.Fields(3) & "" |
0086 | If strColour <> "" Then |
0087 | strColour = " bgcolor=""#" & strColour & """" |
0088 | strLine = Replace(strLine, " **Colour**", strColour) |
0089 | strLetter_Title = "" & strLetter_Title & "" 'Need to add pop-up |
0090 | End If |
0091 | End If |
0092 | End If |
0093 | End If |
0094 | strLine = Replace(strLine, " **Colour**", strColour) |
0095 | x = InStr(1, strLine, "**Column") |
0096 | If x > 0 Then |
0097 | If strLetter <> "" Then |
0098 | If strSplitTable = "No" Then |
0099 | Y = "" & strLetter_Title & "" |
0100 | Else |
0101 | 'For Notes links, need to get the right directory |
0102 | If strTargetFileShort = "Notes" Then |
0103 | If IIf(IsMissing(Run_Type), "", Run_Type) = "Concatenated" Then |
0104 | Else |
0105 | Note_Subdirectory = Find_New_Directory(strLetter) |
0106 | 'Remove irrelevant rubbish for Documentation |
0107 | If Right(strOutputFile, 2) = "13" Then |
0108 | strLetter_Title = Replace(strLetter_Title, "Website Generator Documentation - ", "") |
0109 | End If |
0110 | Note_Subdirectory = "Notes_" & Note_Subdirectory & "/" |
0111 | End If |
0112 | End If |
0113 | If IIf(IsMissing(Run_Type), "", Run_Type) = "Concatenated" Then |
0114 | Y = "" & strLetter_Title & "" |
0115 | Else |
0116 | Y = "" & strLetter_Title & "" |
0117 | End If |
0118 | End If |
0119 | Else |
0120 | Y = " " |
0121 | End If |
0122 | strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 10, Len(strLine)) |
0123 | If Not rsTableToReadLetters.EOF Then |
0124 | rsTableToReadLetters.MoveNext |
0125 | If Not rsTableToReadLetters.EOF Then |
0126 | strLetter = rsTableToReadLetters.Fields(1) |
0127 | strLetter_Title = rsTableToReadLetters.Fields(0) |
0128 | If Notes_Recent > 0 Then |
0129 | 'Find the Master-Note |
0130 | Set rsMasterNote = CurrentDb.OpenRecordset("SELECT Notes.Item_Title, Notes.Note_Group FROM Notes INNER JOIN Master_Notes ON Notes.ID = Master_Notes.Top_Master_Note WHERE (((Master_Notes.ID)=" & strLetter & "));") |
0131 | If Not rsMasterNote.EOF Then |
0132 | rsMasterNote.MoveFirst |
0133 | If rsMasterNote.Fields(1).Value = 5 Then 'For Blog, prefix the Master Note ... |
0134 | If strLetter_Title <> rsMasterNote.Fields(0).Value Then |
0135 | strLetter_Title = strLetter_Title & " (" & rsMasterNote.Fields(0).Value & ")" |
0136 | End If |
0137 | End If |
0138 | End If |
0139 | Set rsMasterNote = Nothing |
0140 | End If |
0141 | Else |
0142 | strLetter = "" |
0143 | End If |
0144 | End If |
0145 | tsTextFile.WriteLine strLine |
0146 | Else |
0147 | tsTextFile.WriteLine strLine |
0148 | End If |
0149 | rsTableControl2.MoveNext |
0150 | Loop |
0151 | End If |
0152 | ' ... Footer |
0153 | 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;" |
0154 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0155 | rsTableControl2.MoveFirst |
0156 | Do While Not rsTableControl2.EOF |
0157 | strLine = rsTableControl2.Fields(0) & "" |
0158 | If InStr(strLine, "**ConcatenatedList**") > 0 Then |
0159 | Concatenated_List_Control = True |
0160 | Form_Concatenated_Notes_List |
0161 | strLine = strList |
0162 | End If |
0163 | tsTextFile.WriteLine strLine |
0164 | rsTableControl2.MoveNext |
0165 | Loop |
0166 | 'Add the colour-code table |
0167 | strLine = " Note Qualities: for an explanation of the colouration in the table above, see the table below! ""Note Quality"" is a new feature, is somewhat experimental, and subject to checking and refinement. " |
0168 | tsTextFile.WriteLine strLine |
0169 | strLine = ""
0170 | tsTextFile.WriteLine strLine |
0171 | strControlQuery = "SELECT Note_Qualities.Note_Quality_Text, Note_Qualities.Note_Quality_Colour, Note_Quality_Explanation FROM Note_Qualities ORDER BY Note_Qualities.Note_Quality;" |
0172 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0173 | rsTableControl2.MoveFirst |
0174 | Do While Not rsTableControl2.EOF |
0175 | strLine = rsTableControl2.Fields(0) & "" |
0176 | strLine = "" & strLine & " | "
0177 | tsTextFile.WriteLine strLine |
0178 | strLine = rsTableControl2.Fields(2) & "" |
0179 | strLine = "" & strLine & " | | " |
0180 | tsTextFile.WriteLine strLine |
0181 | rsTableControl2.MoveNext |
0182 | Loop |
0183 | strLine = " | " |
0184 | tsTextFile.WriteLine strLine |
0185 | 'Extra Footer |
0186 | If IsMissing(Run_Type) Then |
0187 | 'Create the extra footer |
0188 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer2"")) ORDER BY Website_Control.Line;" |
0189 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0190 | rsTableControl2.MoveFirst |
0191 | Do While Not rsTableControl2.EOF |
0192 | strLine = rsTableControl2.Fields(0) & "" |
0193 | OK = Replace_Timestamp(strLine) |
0194 | tsTextFile.WriteLine strLine |
0195 | rsTableControl2.MoveNext |
0196 | Loop |
0197 | End If |
0198 | If IsMissing(Run_Type) Then |
0199 | OK = CopyToTransfer(strFolder, strFileName) |
0200 | Set tsTextFile = Nothing |
0201 | End If |
0202 | Set rsTableControl2 = Nothing |
0203 | Set rsTableToReadLetters = Nothing |
0204 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub JumpTableTitles_Recent_Control() |
0002 | Dim strControlQuery As String |
0003 | Dim rsTableControl2 As Recordset |
0004 | Dim rsTableToRead As Recordset |
0005 | Dim rsPaperAbstracts As Recordset |
0006 | Dim strLetter As String |
0007 | Dim strLetter_Title As String |
0008 | Dim strLine As String |
0009 | Dim x As Integer |
0010 | Dim Y As String |
0011 | Dim fsoTextFile As FileSystemObject |
0012 | Dim tsTextFile As TextStream |
0013 | Dim Title_Loc As Integer |
0014 | Dim strDirectory As String |
0015 | Dim Record_Count As Integer |
0016 | Dim Display_Group As String |
0017 | strControlQuery = "SELECT Note_Groups.ID, Note_Groups.Note_Group, Sum(IIf([Jump_Table?]=Yes,1,0)*IIf([Private?]=""No"",1,0)) AS Total, Sum(IIf((Now()-[Last_Changed]/1000)-7<0,1,0)) AS [7 Days], Sum(IIf((Now()-[Last_Changed]/1000)-14<0,1,0)) AS [14 Days], Sum(IIf((Now()-[Last_Changed]/1000)-28<0,1,0)) AS [28 Days], Note_Groups.[Active?] FROM Note_Groups LEFT JOIN Notes ON Note_Groups.ID = Notes.Note_Group WHERE (((Note_Groups.[Active?])=""Yes"")) GROUP BY Note_Groups.ID, Note_Groups.Note_Group, Note_Groups.[Active?] ORDER BY Note_Groups.Note_Group;" |
0018 | Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery) |
0019 | For Notes_Recent = 0 To 4 |
0020 | If Notes_Recent = 3 Then 'Don't bother with 3-week |
0021 | Else |
0022 | strControlTable = "Jump_Table_Titles_Notes" |
0023 | strOutputFileShort = "Notes_Jump_Changed_" & Notes_Recent * 7 |
0024 | strFileName = strOutputFileShort & ".htm" |
0025 | strTargetFileShort = "Notes_Jump" |
0026 | strOutputRoot = TheoWebsiteRoot & "\Notes\" |
0027 | strFolder = strOutputRoot |
0028 | strOutputFile = strOutputRoot & strOutputFileShort |
0029 | strTargetFile = strOutputRoot & strTargetFileShort |
0030 | strSplitTable = "Yes" |
0031 | Set fsoTextFile = New FileSystemObject |
0032 | Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFile & ".htm", True, True) |
0033 | ' ... Header |
0034 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;" |
0035 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0036 | rsTableControl2.MoveFirst |
0037 | Do While Not rsTableControl2.EOF |
0038 | strLine = rsTableControl2.Fields(0) & "" |
0039 | Title_Loc = InStr(strLine, "**TITLE**") |
0040 | If Title_Loc > 0 Then |
0041 | strLine = Left(strLine, Title_Loc - 1) & IIf(Notes_Recent > 0, "Active Note Groups with Notes Updated in the last " & Notes_Recent * 7 & " days - ", "") & Mid(strLine, Title_Loc + 9, Len(strLine)) |
0042 | End If |
0043 | tsTextFile.WriteLine strLine |
0044 | rsTableControl2.MoveNext |
0045 | Loop |
0046 | 'Rows |
0047 | rsTableToRead.MoveFirst |
0048 | ' ... Rows |
0049 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Rows"")) ORDER BY Website_Control.Line;" |
0050 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0051 | rsTableControl2.MoveFirst |
0052 | strLetter = rsTableToRead.Fields(0) 'Note: this is the internal ID of the Notes Group |
0053 | If rsTableToRead.Fields(0).Value = 10 Then |
0054 | strDirectory = "../Secure_Jen/" |
0055 | Else |
0056 | strDirectory = "" |
0057 | End If |
0058 | Record_Count = IIf(Notes_Recent = 0, rsTableToRead.Fields(2), IIf(Notes_Recent = 1, rsTableToRead.Fields(3), IIf(Notes_Recent = 2, rsTableToRead.Fields(4), rsTableToRead.Fields(5)))) |
0059 | strLetter_Title = rsTableToRead.Fields(1) & " (" & Record_Count & ")" |
0060 | Do While (Not rsTableControl2.EOF Or Not rsTableToRead.EOF) |
0061 | If rsTableControl2.EOF Then |
0062 | rsTableControl2.MoveFirst |
0063 | End If |
0064 | strLine = rsTableControl2.Fields(0) & "" |
0065 | x = InStr(1, strLine, "**Column") |
0066 | If x > 0 Then |
0067 | Display_Group = "No" |
0068 | If Record_Count > 0 Or Notes_Recent = 0 Then |
0069 | Display_Group = "Yes" |
0070 | Else |
0071 | If rsTableToRead.EOF = True Then |
0072 | Display_Group = "Yes" |
0073 | Else |
0074 | If rsTableToRead.Fields(6) = "Yes" Then 'Active Notes Group |
0075 | Display_Group = "Yes" |
0076 | End If |
0077 | End If |
0078 | End If |
0079 | If strLetter <> "" Then |
0080 | Y = " 0, "_Recent_" & Notes_Recent * 7, "") & ".htm"">" & strLetter_Title & "" |
0081 | Else |
0082 | Y = " " |
0083 | End If |
0084 | strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 10, Len(strLine)) |
0085 | If Not rsTableToRead.EOF Then |
0086 | rsTableToRead.MoveNext |
0087 | If Not rsTableToRead.EOF Then |
0088 | strLetter = rsTableToRead.Fields(0) 'Note: this is the internal ID of the Notes Group |
0089 | If rsTableToRead.Fields(0).Value = 10 Then |
0090 | strDirectory = "../Secure_Jen/" |
0091 | Else |
0092 | strDirectory = "" |
0093 | End If |
0094 | strLetter_Title = rsTableToRead.Fields(1) & " (" & IIf(Notes_Recent = 0, rsTableToRead.Fields(2), IIf(Notes_Recent = 1, rsTableToRead.Fields(3), IIf(Notes_Recent = 2, rsTableToRead.Fields(4), rsTableToRead.Fields(5)))) & ")" |
0095 | Else |
0096 | strLetter = "" |
0097 | End If |
0098 | End If |
0099 | Else |
0100 | Display_Group = "Yes" |
0101 | End If |
0102 | If Display_Group = "Yes" Then |
0103 | tsTextFile.WriteLine strLine |
0104 | rsTableControl2.MoveNext |
0105 | End If |
0106 | Loop |
0107 | ' ... Footer |
0108 | 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;" |
0109 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0110 | rsTableControl2.MoveFirst |
0111 | Do While Not rsTableControl2.EOF |
0112 | strLine = rsTableControl2.Fields(0) |
0113 | If InStr(strLine, "**ConcatenatedList**") > 0 Then |
0114 | Concatenated_List_Control = False |
0115 | Form_Concatenated_Notes_List |
0116 | strLine = strList |
0117 | End If |
0118 | tsTextFile.WriteLine strLine |
0119 | rsTableControl2.MoveNext |
0120 | Loop |
0121 | If Notes_Recent > 0 Then |
0122 | 'Add Changed Paper Abstracts |
0123 | strLine = "There follow lists of Papers and / or Books addressed or Abstracts Updated in the last " & Notes_Recent * 7 & " days. These lists are generated automatically from my database, and may not represent significant activity as they are triggered by any database change - eg. re-filing.
" |
0124 | tsTextFile.WriteLine strLine |
0125 | Set rsPaperAbstracts = CurrentDb.OpenRecordset("Select * From Abstracts_Recent Where Abstracts_Recent!Period <= " & Notes_Recent & ";") |
0126 | If Not rsPaperAbstracts.EOF Then |
0127 | rsPaperAbstracts.MoveFirst |
0128 | 'Heading |
0129 | strLine = "Papers addressed or Abstracts Updated in the last " & Notes_Recent * 7 & " days |
0130 | tsTextFile.WriteLine strLine |
0131 | 'Rows |
0132 | Do While Not rsPaperAbstracts.EOF |
0133 | strLine = "" & rsPaperAbstracts.Fields(0) & "" |
0134 | tsTextFile.WriteLine strLine |
0135 | rsPaperAbstracts.MoveNext |
0136 | Loop |
0137 | strLine = " " |
0138 | tsTextFile.WriteLine strLine |
0139 | End If |
0140 | 'Add Changed Book Abstracts ... use rsPaperAbstracts recordset! |
0141 | Set rsPaperAbstracts = CurrentDb.OpenRecordset("Select * From Book_Abstracts_Recent Where Book_Abstracts_Recent!Period <= " & Notes_Recent & ";") |
0142 | If Not rsPaperAbstracts.EOF Then |
0143 | rsPaperAbstracts.MoveFirst |
0144 | 'Heading |
0145 | strLine = "Books addressed or Updated in the last " & Notes_Recent * 7 & " days |
0146 | tsTextFile.WriteLine strLine |
0147 | 'Rows |
0148 | Do While Not rsPaperAbstracts.EOF |
0149 | strLine = "" & rsPaperAbstracts.Fields(0) & "" |
0150 | tsTextFile.WriteLine strLine |
0151 | rsPaperAbstracts.MoveNext |
0152 | Loop |
0153 | strLine = " " |
0154 | tsTextFile.WriteLine strLine |
0155 | End If |
0156 | End If |
0157 | 'Create the extra footer |
0158 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer2"")) ORDER BY Website_Control.Line;" |
0159 | Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery) |
0160 | rsTableControl2.MoveFirst |
0161 | Do While Not rsTableControl2.EOF |
0162 | strLine = rsTableControl2.Fields(0) & "" |
0163 | OK = Replace_Timestamp(strLine) |
0164 | tsTextFile.WriteLine strLine |
0165 | rsTableControl2.MoveNext |
0166 | Loop |
0167 | 'Copy to Transfer Drive |
0168 | OK = CopyToTransfer(strFolder, strFileName) |
0169 | End If |
0170 | Set rsPaperAbstracts = Nothing |
0171 | Next Notes_Recent |
0172 | Set rsTableControl2 = Nothing |
0173 | Set rsTableToRead = Nothing |
0174 | Set tsTextFile = Nothing |
0175 | End Sub |