THEO TODMAN’S WEBSITE CODE PAGES



This Page provides a jumping-off point for the VBA Code that generates my Website.

Table of Code Documentation Location 10 (5 items)

CreatePapersWebTableFind_Master_NotesImport_DataJumpTableTitles
JumpTableTitles_Recent_Control...

To access information, click on one of the links in the table above.

Go to top of page




Source Code of: CreatePapersWebTable
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 823
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub CreatePapersWebTable()
0002Dim fsoTextFile As FileSystemObject
0003Dim strFileSuffix As String
0004Dim strFileSuffix_Previous As String
0005Dim strFileTitle As String
0006Dim strFileTitle_Previous As String
0007Dim tsTextFile As TextStream
0008Dim tsJumpFile As TextStream
0009Dim tsJumpFile2 As TextStream
0010Dim tsJumpFile3 As TextStream
0011Dim rsAbstractQuality As Recordset
0012Dim rsTableToRead As Recordset
0013Dim rsTableToReadLetters As Recordset
0014Dim rsTableToReadJump2 As Recordset
0015Dim rsTableToReadJump3 As Recordset
0016Dim rsTableToReadJump4 As Recordset
0017Dim rsTableControl As Recordset
0018Dim rsTableControl2 As Recordset
0019Dim rsTableControl3 As Recordset
0020Dim rsTableControl_BB As Recordset
0021Dim strControlQuery As String
0022Dim strLine As String
0023Dim strQuery As String
0024Dim iTableColumns As Integer
0025Dim iFieldNo As Integer
0026Dim iIDCol As Integer
0027Dim x As Integer
0028Dim Y As String
0029Dim z As String
0030Dim z1 As String
0031Dim z2 As String
0032Dim strLetter As String
0033Dim strLetter_Title As String
0034Dim strControlBreak As String
0035Dim strControlBreak_Last As String
0036Dim strCol1Break As String
0037Dim strCol1Break_Last As String
0038Dim strLine_SavedHeader As String
0039Dim strLine_SavedFooter As String
0040Dim i As Integer
0041Dim strLetter_Title_Short As String
0042Dim strLetter_Title2 As String
0043Dim Jump_type As Integer
0044Dim File_Suffix As String
0045Dim start As Date
0046Dim strNextPageQuery As String
0047Dim NextPage As String
0048Dim NextPageID As String
0049Dim LeftLink As String
0050Dim RightLink As String
0051Dim LinkTable As String
0052Dim Toplink As String
0053Dim MaxLen As Integer
0054Dim Time_Stamp As String
0055Dim RightPct As Integer
0056Dim LeftPct As Integer
0057Dim RightLen As Integer
0058Dim LeftLen As Integer
0059start = Now()
0060Set fsoTextFile = New FileSystemObject
0061'Create Control File
0062strFolder = strOutputFolder
0063strFileName = strOutputFileShort & ".htm"
0064Set tsTextFile = fsoTextFile.CreateTextFile(strFolder & strFileName, True, True)
0065strLine_SavedHeader = ""
0066'Find Footer for BB Pages
0067strLine_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;"
0069Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0070rsTableControl.MoveFirst
0071Do While Not rsTableControl.EOF
0072 strLine_SavedFooter = strLine_SavedFooter & rsTableControl.Fields(0)
0073 rsTableControl.MoveNext
0074Loop
0075 OK = Replace_Timestamp(strLine_SavedFooter)
0076'Control Page Header
0077If 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;"
0079Else
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;"
0081End If
0082Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0083rsTableControl.MoveFirst
0084Do 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 = "<BR><P ALIGN = ""Left""><FONT Size = 2 FACE=""Arial"">"
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 = "<B><U>Level 1 Jump</B></U><BR><BR>"
0105 tsTextFile.WriteLine strLine
0106 Do While Not rsTableToReadLetters.EOF
0107 strLine = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & ".htm"">" & rsTableToReadLetters.Fields(1) & " - " & rsTableToReadLetters.Fields(2) & "</A><BR>"
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 & "<BR><B><U>Level 2 Jump</B></U><BR><BR>"
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 = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & ".htm"">" & rsTableToReadJump2.Fields(1) & " - " & rsTableToReadJump2.Fields(2) & "</A><BR>"
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 & "<BR><B><U>Level 3 Jump</B></U><BR><BR>"
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 = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & ".htm"">" & rsTableToReadJump3.Fields(1) & " - " & rsTableToReadJump3.Fields(2) & "</A><BR>"
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 & "<BR><B><U>Level 4 Jump</B></U><BR><BR>"
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 = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & "_" & rsTableToReadJump4.Fields(0) & ".htm"">" & rsTableToReadJump4.Fields(1) & " - " & rsTableToReadJump4.Fields(2) & "</A><BR>"
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 rsTableToReadLetters.MoveFirst
0176 strLetter = rsTableToReadLetters.Fields(0)
0177 Do While Not rsTableControl2.EOF
0178 strLine = rsTableControl2.Fields(0) & ""
0179 x = InStr(1, strLine, "**Column")
0180 If x > 0 Then
0181 Y = Mid(strLine, x + 8, 1)
0182 If Y < strLetter Then
0183 strLine = Left(strLine, x - 1) & "." & Mid(strLine, x + 11, Len(strLine))
0184 Else
0185 If strSplitTable = "No" Then
0186 Y = "<A HREF=""#Section" & Y & """>" & Y & "</A>"
0187 Else
0188 Y = "<A HREF=""" & strOutputFileShort & "_" & Y & ".htm"">" & Y & "</A>"
0189 End If
0190 strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 11, Len(strLine))
0191 If Not rsTableToReadLetters.EOF Then
0192 rsTableToReadLetters.MoveNext
0193 If Not rsTableToReadLetters.EOF Then
0194 strLetter = Left(rsTableToReadLetters.Fields(0), 1)
0195 Else
0196 strLetter = "ZZZ"
0197 End If
0198 End If
0199 End If
0200 tsTextFile.WriteLine strLine
0201 Else
0202 tsTextFile.WriteLine strLine
0203 End If
0204 rsTableControl2.MoveNext
0205 Loop
0206 Else
0207 'Title-based jump table
0208 ' ... Header
0209 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;"
0210 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0211 rsTableControl2.MoveFirst
0212 Do While Not rsTableControl2.EOF
0213 strLine = rsTableControl2.Fields(0) & ""
0214 tsTextFile.WriteLine strLine
0215 rsTableControl2.MoveNext
0216 Loop
0217 ' ... Rows
0218 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;"
0219 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0220 rsTableControl2.MoveFirst
0221 If strControlBreakType2 = "2-Level" Then
0222 Set rsTableToReadLetters = CurrentDb.OpenRecordset(strDataQuery & " (Titles) - Top")
0223 Else
0224 Set rsTableToReadLetters = CurrentDb.OpenRecordset(strDataQuery & " (Titles)")
0225 End If
0226 rsTableToReadLetters.MoveFirst
0227 z = rsTableToReadLetters.Fields(0).Name
0228 z1 = rsTableToReadLetters.Fields(1).Name
0229 strLetter = rsTableToReadLetters.Fields(1) 'Note: this is the internal ID of the field
0230 strLetter_Title = rsTableToReadLetters.Fields(0)
0231 Do While (Not rsTableControl2.EOF Or Not rsTableToReadLetters.EOF)
0232 If rsTableControl2.EOF Then
0233 rsTableControl2.MoveFirst
0234 End If
0235 If strSplitTable = "No" Then
0236 Else
0237 Jump_type = 1
0238 If rsTableToReadLetters.Fields.Count > 2 Then
0239 If Not rsTableToReadLetters.EOF Then
0240 If rsTableToReadLetters.Fields(2) = 1 Then
0241 Jump_type = 1
0242 Else
0243 Jump_type = 2
0244 End If
0245 End If
0246 End If
0247 End If
0248 strLine = rsTableControl2.Fields(0) & ""
0249 x = InStr(1, strLine, "**Column")
0250 If x > 0 Then
0251 If strLetter <> "" Then
0252 If strSplitTable = "No" Then
0253 If InStr(strLetter_Title, "<BR>") > 0 Then
0254 strLetter_Title_Short = Left(strLetter_Title, InStr(strLetter_Title, "<BR>") - 1)
0255 Else
0256 strLetter_Title_Short = strLetter_Title
0257 End If
0258 Y = "<A HREF=""#Section" & Replace(strLetter_Title_Short, " ", "_") & """>" & strLetter_Title & "</A>"
0259 Else
0260 If strControlBreakType2 = "2-Level" Then
0261 If Jump_type = 2 Then
0262 Y = "<A HREF=""" & strOutputFileShort & "_Top_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0263 Else
0264 File_Suffix = strLetter
0265 Y = "<A HREF=""" & strOutputFileShort & "_" & File_Suffix & ".htm"">" & strLetter_Title & "</A>"
0266 End If
0267 Else
0268 Y = "<A HREF=""" & strOutputFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0269 End If
0270 End If
0271 Else
0272 Y = "."
0273 End If
0274 strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 10, Len(strLine))
0275 If Not rsTableToReadLetters.EOF Then
0276 rsTableToReadLetters.MoveNext
0277 If Not rsTableToReadLetters.EOF Then
0278 strLetter = rsTableToReadLetters.Fields(1)
0279 strLetter_Title = rsTableToReadLetters.Fields(0)
0280 If strControlBreakType2 = "2-Level" Then
0281 If rsTableToReadLetters.Fields(2) = 1 Then
0282 Jump_type = 1
0283 Else
0284 Jump_type = 2
0285 End If
0286 End If
0287 Else
0288 strLetter = ""
0289 End If
0290 End If
0291 tsTextFile.WriteLine strLine
0292 Else
0293 tsTextFile.WriteLine strLine
0294 End If
0295 rsTableControl2.MoveNext
0296 Loop
0297 ' ... Footer
0298 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;"
0299 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0300 rsTableControl2.MoveFirst
0301 Do While Not rsTableControl2.EOF
0302 strLine = rsTableControl2.Fields(0) & ""
0303 tsTextFile.WriteLine strLine
0304 rsTableControl2.MoveNext
0305 Loop
0306 If strControlBreakType2 = "2-Level" Then
0307 'Add a second-level set of Jump tables if necessary
0308 Set rsTableToReadJump4 = CurrentDb.OpenRecordset(strDataQuery & " (Titles) - Top")
0309 rsTableToReadJump4.MoveFirst
0310 Do While Not rsTableToReadJump4.EOF
0311 If rsTableToReadJump4.Fields(2) > 1 Then
0312 strLetter_Title2 = rsTableToReadJump4.Fields(1)
0313 strLetter_Title_Short = Left(rsTableToReadJump4.Fields(0), InStr(rsTableToReadJump4.Fields(0), "<BR>") - 1)
0314 Set tsJumpFile = fsoTextFile.CreateTextFile(strOutputFile & "_Top_" & strLetter_Title2 & ".htm", True, True)
0315 'Page Header
0316 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;"
0317 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0318 rsTableControl2.MoveFirst
0319 Do While Not rsTableControl2.EOF
0320 strLine = rsTableControl2.Fields(0) & ""
0321 x = InStr(1, strLine, "**TITLE_HEAD**")
0322 If x > 0 Then
0323 strLine = Left(strLine, x - 1) & rsTableToReadJump4.Fields(0) & " - " & Mid(strLine, x + 15, Len(strLine))
0324 strLine = Replace(strLine, "<BR>", " ")
0325 End If
0326 x = InStr(1, strLine, "**SECTION**")
0327 If x > 0 Then
0328 strLine = Left(strLine, x - 1) & ": " & rsTableToReadJump4.Fields(0) & Mid(strLine, x + 11, Len(strLine))
0329 'Find Next page
0330 strNextPageQuery = "SELECT [" & strDataQuery & " (Titles) - Top].* FROM [" & strDataQuery & " (Titles) - Top];"
0331 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0332 rsTableControl3.MoveFirst
0333 z = rsTableControl3.Fields(0).Name
0334 z1 = rsTableControl3.Fields(1).Name
0335 z2 = rsTableControl3.Fields(2).Name
0336 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 & "];"
0337 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0338 If rsTableControl3.EOF Then
0339 NextPage = ""
0340 NextPageID = ""
0341 Else
0342 rsTableControl3.MoveFirst
0343 NextPage = rsTableControl3.Fields(0)
0344 NextPage = Left(NextPage, InStr(NextPage, "<") - 1)
0345 NextPageID = rsTableControl3.Fields(1)
0346 If rsTableControl3.Fields(2) = 1 Then
0347 NextPageID = NextPageID
0348 Else
0349 NextPageID = "Top_" & NextPageID
0350 End If
0351 End If
0352 LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: <a href=""" & strOutputFileShort & "_Top_" & strFileSuffix_Previous & ".htm"">" & strFileTitle_Previous & "</a>")
0353 LeftLen = IIf(strFileSuffix_Previous = "", Len("Previous Page: None"), Len("Previous Page: " & strFileTitle_Previous))
0354 RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: <a href=""" & strOutputFileShort & "_" & NextPageID & ".htm"">" & NextPage & "</a>")
0355 RightLen = IIf(NextPage = "", Len("Next Page: None"), Len("Next Page: " & NextPage))
0356 If LeftLen > RightLen Then
0357 MaxLen = LeftLen
0358 Else
0359 MaxLen = RightLen
0360 End If
0361 MaxLen = 200 + 15 * MaxLen
0362 If MaxLen > 950 Then
0363 LeftPct = Round((LeftLen + 100 / 8) / (LeftLen + RightLen + 200 / 8) * 100, 0)
0364 RightPct = 100 - LeftPct
0365 MaxLen = 200 + (LeftLen + RightLen) * 8
0366 Else
0367 LeftPct = 50
0368 RightPct = 50
0369 End If
0370 LinkTable = "<center><TABLE class = ""Bridge"" WIDTH=" & MaxLen & "><tr><th colspan=2><a href=""" & strOutputFileShort & ".htm"">Top Jump Table</a></th></tr><tr><th WIDTH=""" & LeftPct & "%"">" & LeftLink & "</th><th WIDTH=""" & RightPct & "%"">" & RightLink & "</th></tr></TABLE></center>"
0371 strLine = strLine & LinkTable
0372 strFileSuffix_Previous = strLetter_Title2
0373 strFileTitle_Previous = rsTableToReadJump4.Fields(0)
0374 strFileTitle_Previous = Left(strFileTitle_Previous, InStr(strFileTitle_Previous, "<") - 1)
0375 End If
0376 tsJumpFile.WriteLine strLine
0377 rsTableControl2.MoveNext
0378 Loop
0379 ' ... Header
0380 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;"
0381 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0382 rsTableControl2.MoveFirst
0383 Do While Not rsTableControl2.EOF
0384 strLine = rsTableControl2.Fields(0) & ""
0385 tsJumpFile.WriteLine strLine
0386 rsTableControl2.MoveNext
0387 Loop
0388 ' ... Rows
0389 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;"
0390 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0391 rsTableControl2.MoveFirst
0392 strQuery = strDataQuery & " (Titles)"
0393 strQuery = "SELECT [" & strQuery & "].Category, [" & strQuery & "].ID FROM [" & strQuery & "] WHERE ((([" & strQuery & "].Top_ID) = """ & strLetter_Title2 & """)) ORDER BY [" & strQuery & "].Category;"
0394 Set rsTableToReadLetters = CurrentDb.OpenRecordset(strQuery)
0395 If Not rsTableToReadLetters.EOF Then 'This is a fudge for "Music Music" (202_35) and maybe others.
0396 rsTableToReadLetters.MoveFirst
0397 strLetter = rsTableToReadLetters.Fields(1) 'Note: this is the internal ID of the field
0398 strLetter_Title = rsTableToReadLetters.Fields(0)
0399 End If
0400 Do While (Not rsTableControl2.EOF Or Not rsTableToReadLetters.EOF)
0401 If rsTableControl2.EOF Then
0402 rsTableControl2.MoveFirst
0403 End If
0404 strLine = rsTableControl2.Fields(0) & ""
0405 x = InStr(1, strLine, "**Column")
0406 If x > 0 Then
0407 If strLetter <> "" Then
0408 If strSplitTable = "No" Then
0409 If InStr(strLetter_Title, "<BR>") > 0 Then
0410 strLetter_Title_Short = Left(strLetter_Title, InStr(strLetter_Title, "<BR>") - 1)
0411 Else
0412 strLetter_Title_Short = strLetter_Title
0413 End If
0414 Y = "<A HREF=""#Section" & Replace(strLetter_Title_Short, " ", "_") & """>" & strLetter_Title & "</A>"
0415 Else
0416 If strControlBreakType2 = "2-Level" Then
0417 Y = "<A HREF=""" & strOutputFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0418 Else
0419 Y = "<A HREF=""" & strOutputFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0420 End If
0421 End If
0422 Else
0423 Y = "."
0424 End If
0425 strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 10, Len(strLine))
0426 If Not rsTableToReadLetters.EOF Then
0427 rsTableToReadLetters.MoveNext
0428 If Not rsTableToReadLetters.EOF Then
0429 strLetter = rsTableToReadLetters.Fields(1)
0430 strLetter_Title = rsTableToReadLetters.Fields(0)
0431 Else
0432 strLetter = ""
0433 End If
0434 End If
0435 tsJumpFile.WriteLine strLine
0436 Else
0437 tsJumpFile.WriteLine strLine
0438 End If
0439 rsTableControl2.MoveNext
0440 Loop
0441 ' ... Footer
0442 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;"
0443 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0444 rsTableControl2.MoveFirst
0445 Do While Not rsTableControl2.EOF
0446 strLine = rsTableControl2.Fields(0) & ""
0447 tsJumpFile.WriteLine strLine
0448 rsTableControl2.MoveNext
0449 Loop
0450 tsJumpFile.WriteLine "<center>"
0451 'Page Footer
0452 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;"
0453 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0454 rsTableControl2.MoveFirst
0455 Do While Not rsTableControl2.EOF
0456 Time_Stamp = rsTableControl2.Fields(0)
0457 OK = Replace_Timestamp(Time_Stamp)
0458 tsJumpFile.WriteLine Time_Stamp
0459 rsTableControl2.MoveNext
0460 Loop
0461 'Copy page to Transfer directory
0462 OK = CopyToTransfer(strFolder, strOutputFileShort & "_Top_" & strLetter_Title2 & ".htm")
0463 Set tsJumpFile = Nothing
0464 End If
0465 rsTableToReadJump4.MoveNext
0466 Loop
0467 End If
0468 End If
0469 End If
0470 Else
0471 OK = Replace_Timestamp(strLine)
0472 strLine_SavedHeader = strLine_SavedHeader & rsTableControl.Fields(0)
0473 tsTextFile.WriteLine strLine
0474 End If
0475 rsTableControl.MoveNext
0476Loop
0477DataRead:
0478'Read the data
0479Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery)
0480iIDCol = rsTableToRead.Fields.Count 'Log the last column number (which contains the record ID)
0481rsTableToRead.MoveFirst
0482strControlBreak = Left(rsTableToRead.Fields(0) & "", 1)
0483'Force a control-break
0484strControlBreak_Last = "@"
0485iTableColumns = rsTableToRead.Fields.Count
0486strFileSuffix = ""
0487strFileTitle = ""
0488If strSplitTable = "No" Then 'This is for tables that don't split across web-pages, so have intermediate control breaks
0489 'Read Table-Control for rows
0490 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;"
0491 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0492 If strControlBreakType = "xInitial" Then 'This has been disabled ... remove if proved not to be needed
0493 'Table Column Headings
0494 rsTableControl.MoveFirst
0495 Do While Not rsTableControl.EOF
0496 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0497 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0498 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0499 tsTextFile.WriteLine "<strong> " & rsTableToRead.Fields(iFieldNo - 1).Name & "</strong>"
0500 End If
0501 Else
0502 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0503 End If
0504 rsTableControl.MoveNext
0505 Loop
0506 End If
0507End If
0508z = rsTableToRead.Fields(0).Name
0509z1 = rsTableToRead.Fields(iTableColumns - 2).Name
0510Do Until rsTableToRead.EOF
0511 strFileSuffix_Previous = strFileSuffix
0512 strFileTitle_Previous = strFileTitle
0513 If strControlBreakType2 = "BB" Then
0514 strFileSuffix = "_" & rsTableToRead.Fields(2) & ""
0515 Else
0516 If strSplitTable = "No" Then
0517 strFileSuffix = ""
0518 Else
0519 If strControlBreakType = "Initial" Then
0520 strFileSuffix = "_" & UCase(Left(rsTableToRead.Fields(0) & "", 1))
0521 Else
0522 strFileSuffix = "_" & rsTableToRead.Fields(iTableColumns - 2) & ""
0523 strFileTitle = rsTableToRead.Fields(0) & ""
0524 End If
0525 End If
0526 End If
0527 If strFileSuffix_Previous <> strFileSuffix Then
0528 'Write the previous Footer
0529 If strFileSuffix_Previous <> "" Then
0530 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;"
0531 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0532 rsTableControl.MoveFirst
0533 Do While Not rsTableControl.EOF
0534 Time_Stamp = rsTableControl.Fields(0) & ""
0535 OK = Replace_Timestamp(Time_Stamp)
0536 tsTextFile.WriteLine Time_Stamp
0537 rsTableControl.MoveNext
0538 Loop
0539 OK = CopyToTransfer(strFolder, strOutputFileShort & strFileSuffix_Previous & ".htm")
0540 End If
0541 'Create File
0542 Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFile & strFileSuffix & ".htm", True, True)
0543 'Page Header
0544 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;"
0545 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0546 rsTableControl.MoveFirst
0547 Do While Not rsTableControl.EOF
0548 strLine = rsTableControl.Fields(0) & ""
0549 x = InStr(1, strLine, "**TITLE_HEAD**")
0550 If x > 0 Then
0551 If strControlBreakType2 = "BB" Then
0552 strLine = Left(strLine, x - 1) & "Section: " & rsTableToRead.Fields(3) & " - " & Mid(strLine, x + 14, Len(strLine))
0553 Else
0554 If strSplitTable = "No" Then
0555 strLine = Left(strLine, x - 1) & Mid(strLine, x + 15, Len(strLine))
0556 Else
0557 If strControlBreakType = "Initial" Then
0558 strLine = Left(strLine, x - 1) & "Section: " & Right(strFileSuffix, 1) & " - " & Mid(strLine, x + 14, Len(strLine))
0559 Else
0560 strLine = Left(strLine, x - 1) & "Section: " & rsTableToRead.Fields(0) & " - " & Mid(strLine, x + 14, Len(strLine))
0561 End If
0562 End If
0563 End If
0564 End If
0565 x = InStr(1, strLine, "**SECTION**")
0566 If x > 0 Then
0567 If strControlBreakType2 = "BB" Then
0568 strLine = Left(strLine, x - 1) & rsTableToRead.Fields(3) & Mid(strLine, x + 11, Len(strLine))
0569 Else
0570 If strSplitTable = "No" Then
0571 strLine = Left(strLine, x - 1) & "A-Z" & Mid(strLine, x + 11, Len(strLine))
0572 Else
0573 If strControlBreakType = "Initial" Then
0574 strLine = Left(strLine, x - 1) & Right(strFileSuffix, 1) & Mid(strLine, x + 11, Len(strLine))
0575 'Find Next page
0576 strNextPageQuery = "SELECT [" & strDataQuery & " (Letters)].* FROM [" & strDataQuery & " (Letters)];"
0577 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0578 rsTableControl3.MoveFirst
0579 z = rsTableControl3.Fields(0).Name
0580 strNextPageQuery = "SELECT [" & strDataQuery & " (Letters)].[" & z & "] FROM [" & strDataQuery & " (Letters)] WHERE ((([" & strDataQuery & " (Letters)].[" & z & "])>""" & rsTableToRead.Fields(0).Value & """)) ORDER BY [" & strDataQuery & " (Letters)].[" & z & "];"
0581 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0582 If rsTableControl3.EOF Then
0583 NextPage = ""
0584 NextPageID = ""
0585 Else
0586 rsTableControl3.MoveFirst
0587 NextPage = rsTableControl3.Fields(0)
0588 End If
0589 LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: <a href=""" & strOutputFileShort & strFileSuffix_Previous & ".htm"">" & Right(strFileSuffix_Previous, 1) & "</a>")
0590 RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: <a href=""" & strOutputFileShort & "_" & NextPage & ".htm"">" & NextPage & "</a>")
0591 LinkTable = "<center><TABLE class = ""Bridge"" WIDTH=600><tr><th colspan=2><a href=""" & strOutputFileShort & ".htm"">Top Jump Table</a></th></tr><tr><th WIDTH=""50%"">" & LeftLink & "</th><th WIDTH=""50%"">" & RightLink & "</th></tr></TABLE></center>"
0592 strLine = strLine & LinkTable
0593 Else
0594 strLine = Left(strLine, x - 1) & ": " & rsTableToRead.Fields(0) & Mid(strLine, x + 11, Len(strLine))
0595 'Find Next page
0596 strNextPageQuery = "SELECT [" & strDataQuery & "].[" & z & "], [" & strDataQuery & "].[" & z1 & "] FROM [" & strDataQuery & "] WHERE ((([" & strDataQuery & "].[" & z & "])>""" & rsTableToRead.Fields(0).Value & """)) ORDER BY [" & strDataQuery & "].[" & z & "];"
0597 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0598 If rsTableControl3.EOF Then
0599 NextPage = ""
0600 NextPageID = ""
0601 Else
0602 rsTableControl3.MoveFirst
0603 NextPage = rsTableControl3.Fields(0)
0604 NextPageID = rsTableControl3.Fields(1)
0605 End If
0606 LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: <a href=""" & strOutputFileShort & strFileSuffix_Previous & ".htm"">" & strFileTitle_Previous & "</a>")
0607 LeftLen = IIf(strFileSuffix_Previous = "", Len("Previous Page: None"), Len("Previous Page: " & strFileTitle_Previous))
0608 RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: <a href=""" & strOutputFileShort & "_" & NextPageID & ".htm"">" & NextPage & "</a>")
0609 RightLen = IIf(NextPage = "", Len("Next Page: None"), Len("Next Page: " & NextPage))
0610 If LeftLen > RightLen Then
0611 MaxLen = LeftLen
0612 Else
0613 MaxLen = RightLen
0614 End If
0615 MaxLen = 200 + 15 * MaxLen
0616 If MaxLen > 950 Then
0617 LeftPct = Round((LeftLen + 100 / 8) / (LeftLen + RightLen + 200 / 8) * 100, 0)
0618 RightPct = 100 - LeftPct
0619 MaxLen = 200 + (LeftLen + RightLen) * 8
0620 Else
0621 LeftPct = 50
0622 RightPct = 50
0623 End If
0624 'Find next level up (if there is one)
0625 If InStr(2, strFileSuffix, "_") > 0 Then
0626 If InStr(rsTableToRead.Fields(0), " - ") > 0 Then
0627 Toplink = "<tr><th colspan=2>Next Level Up: <a href=""" & strOutputFileShort & "_Top" & Left(strFileSuffix, InStr(2, strFileSuffix, "_") - 1) & ".htm"">" & Left(rsTableToRead.Fields(0), InStr(rsTableToRead.Fields(0), " - ") - 1) & "</a></th></tr>"
0628 Else
0629 Toplink = "<tr><th colspan=2>Next Level Up: <a href=""" & strOutputFileShort & "_Top" & Left(strFileSuffix, InStr(2, strFileSuffix, "_") - 1) & ".htm"">" & rsTableToRead.Fields(0) & "</a></th></tr>"
0630 End If
0631 'Check for solitons
0632 On Error Resume Next
0633 strNextPageQuery = "SELECT [" & strDataQuery & " (Titles) - Solitons].[ID] FROM [" & strDataQuery & " (Titles) - Solitons] WHERE ((([" & strDataQuery & " (Titles) - Solitons].[ID])=""" & Mid(strFileSuffix, 2, 100) & """));"
0634 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0635 If rsTableControl3.EOF Then
0636 Else
0637 Toplink = ""
0638 End If
0639 On Error GoTo 0
0640 Else
0641 Toplink = ""
0642 End If
0643 LinkTable = "<center><TABLE class = ""Bridge"" WIDTH=" & MaxLen & "><tr><th colspan=2><a href=""" & strOutputFileShort & ".htm"">Top Jump Table</a></th></tr>" & Toplink & "<tr><th WIDTH=""" & LeftPct & "%"">" & LeftLink & "</th><th WIDTH=""" & RightPct & "%"">" & RightLink & "</th></tr></TABLE></center>"
0644 strLine = strLine & LinkTable
0645 End If
0646 End If
0647 End If
0648 End If
0649 tsTextFile.WriteLine strLine
0650 rsTableControl.MoveNext
0651 Loop
0652 'Read Table-Control for rows
0653 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;"
0654 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0655 If strControlBreakType2 = "BB" Then
0656 'Write out the 2nd Jump List
0657 strControlQuery = "SELECT [" & strDataQuery & " (Breaks)].Break FROM [" & strDataQuery & " (Breaks)] WHERE ((([" & strDataQuery & " (Breaks)].Suffix)=""" & Mid(strFileSuffix, 2, Len(strFileSuffix)) & """));"
0658 Set rsTableControl_BB = CurrentDb.OpenRecordset(strControlQuery)
0659 If Not rsTableControl_BB.EOF Then
0660 rsTableControl_BB.MoveFirst
0661 Do While Not rsTableControl_BB.EOF
0662 tsTextFile.WriteLine "<A HREF=""#" & rsTableControl_BB.Fields(0) & """>" & rsTableControl_BB.Fields(0) & "</A><BR>"
0663 rsTableControl_BB.MoveNext
0664 Loop
0665 tsTextFile.WriteLine "<BR><BR><HR>"
0666 strCol1Break_Last = ""
0667 i = 1
0668 tsTextFile.WriteLine "<P ALIGN=""Left""><FONT Size = 2 FACE=""Arial"">"
0669 End If
0670 Else
0671 'Table Column Headings
0672 rsTableControl.MoveFirst
0673 Do While Not rsTableControl.EOF
0674 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0675 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0676 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0677 tsTextFile.WriteLine "<B> " & rsTableToRead.Fields(iFieldNo - 1).Name & "</B>"
0678 End If
0679 Else
0680 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0681 End If
0682 rsTableControl.MoveNext
0683 Loop
0684 End If
0685 End If
0686 'Internal Control Breaks
0687 If strControlBreakType = "Initial" Then
0688 strControlBreak = Left(rsTableToRead.Fields(0), 1)
0689 Else
0690 strControlBreak = Replace(rsTableToRead.Fields(0) & "", " ", "_")
0691 End If
0692 If strControlBreak_Last <> strControlBreak Then
0693 If strSplitTable = "No" Then
0694 'Add an internal table break + reference
0695 tsTextFile.WriteLine "</TABLE><a name=""Section" & Replace(strControlBreak, " ", "_") & """></a><h3>SECTION: " & Replace(strControlBreak, "_", " ") & "</h3><TABLE class = ""ReadingList"" WIDTH=950>"
0696 'Table Column Headings
0697 rsTableControl.MoveFirst
0698 Do While Not rsTableControl.EOF
0699 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0700 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0701 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0702 tsTextFile.WriteLine "<B> " & rsTableToRead.Fields(iFieldNo - 1).Name & "</B>"
0703 End If
0704 Else
0705 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0706 End If
0707 rsTableControl.MoveNext
0708 Loop
0709 End If
0710 strControlBreak_Last = strControlBreak
0711 End If
0712 'Table Row
0713 rsTableControl.MoveFirst
0714 Do While Not rsTableControl.EOF
0715 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0716 If strControlBreakType2 = "BB" Then
0717 strCol1Break = rsTableToRead.Fields(0)
0718 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0719 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0720 If iFieldNo = 1 Then
0721 If strCol1Break <> strCol1Break_Last Then
0722 strLine = "<A NAME=""" & strCol1Break & """></A><BR><B><U>" & strCol1Break & "</U></B><BR>"
0723 tsTextFile.WriteLine strLine
0724 i = 1
0725 End If
0726 Else
0727 If Left(strControlTable, 4) = "Book" Then
0728 strLine = i & ". " & rsTableToRead.Fields(iFieldNo - 1) & IIf(iFieldNo < iTableColumns, IIf(rsTableToRead.Fields(iTableColumns - 1) > 0, " (<A HREF = ""../../BookSummaries/BookSummary_" & Right(Str(Int(rsTableToRead.Fields(iTableColumns - 1) / 1000) + 1000000), 2) & "/BookSummary_" & rsTableToRead.Fields(iIDCol - 1) & ".htm"">More</A>)", ""), "") & "<BR>"
0729 Else
0730 strLine = i & ". " & rsTableToRead.Fields(iFieldNo - 1) & IIf(iFieldNo < iTableColumns, IIf(rsTableToRead.Fields(iTableColumns - 1) > 0, " (<A HREF = ""../Abstracts/Abstract_" & Right(Str(Int(rsTableToRead.Fields(iTableColumns - 1) / 1000) + 1000000), 2) & "/Abstract_" & rsTableToRead.Fields(iTableColumns - 1) & ".htm"">Abstract</A>)", ""), "") & " ... <A HREF = ""../PaperSummaries/PaperSummary_" & Right(Str(Int(rsTableToRead.Fields(iTableColumns - 2) / 1000) + 1000000), 2) & "/PaperSummary_" & rsTableToRead.Fields(iIDCol - 2) & ".htm"">More</A><BR>"
0731 End If
0732 tsTextFile.WriteLine strLine
0733 End If
0734 End If
0735 Else
0736 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0737 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0738 If Len(rsTableToRead.Fields(iFieldNo - 1) & "") = 0 Then
0739 tsTextFile.WriteLine "&nbsp;"
0740 Else
0741 If rsTableToRead.Fields(iFieldNo - 1).Name = "Abstract" Then
0742 'Generate Paper Sumary & Abstract Links
0743 strLine = PaperSumaryAbstract_Links(rsTableToRead.Fields(iFieldNo - 1).Value, rsTableToRead.Fields(iIDCol - 1))
0744 Else
0745 strLine = rsTableToRead.Fields(iFieldNo - 1)
0746 If rsTableToRead.Fields(iFieldNo - 1).Name = "Source" Then
0747 strLine = Remove_Dummy_Ref(strLine)
0748 strLine = WebEncode(strLine)
0749 OK = Reference_Books(strLine, "X", 0, 0, 0)
0750 OK = Reference_Papers(strLine, "X", 0, 0, 0)
0751 OK = Reference_Webrefs(strLine, "X", 0, 0)
0752 Else
0753 If rsTableToRead.Fields(iFieldNo - 1).Name = "Link" Then
0754 If strLine = "**Precis**" Then 'Comments that were null, or (most likely) contained part of the precis
0755 strLine = ""
0756 Else
0757 strLine = Replace(strLine, "../", "")
0758 End If
0759 strLine = Remove_Dummy_Ref(strLine)
0760 strLine = WebEncode(strLine)
0761 OK = Reference_Books(strLine, "X", 0, 0, 0)
0762 OK = Reference_Papers(strLine, "X", 0, 0, 0)
0763 OK = Reference_Notes(strLine, "X", 0, 0, 0)
0764 OK = Reference_Notes(strLine, "X", 0, 0, 0, "Abstract_Direct")
0765 OK = Reference_Webrefs(strLine, "X", 0, 0)
0766 strLine = NumberedBullets(strLine)
0767 strLine = Bullets(strLine)
0768 tsTextFile.WriteLine "<A HREF = ""PaperSummaries/PaperSummary_" & Mid(rsTableToRead.Fields(iTableColumns - 1) + 100000, 2, 2) & "/PaperSummary_" & rsTableToRead.Fields(iTableColumns - 1) & ".htm"">" & "Summary" & "</A>, <A HREF = ""Abstracts/Abstract_" & Mid(rsTableToRead.Fields(iTableColumns - 1) + 100000, 2, 2) & "/Abstract_" & rsTableToRead.Fields(iTableColumns - 1) & ".htm"">Abstract</A><br>"
0769 If Len(strLine) > 500 Then
0770 strLine = "Précis link too long - follow above link to Abstract"
0771 End If
0772 Else
0773 If rsTableToRead.Fields(iFieldNo - 1).Name = "Author" Then
0774 OK = Author_Reference_String(strLine, 0)
0775 End If
0776 End If
0777 End If
0778 End If
0779 strLine = Replace(strLine, Chr(13) & Chr(10), "<BR>")
0780 tsTextFile.WriteLine strLine
0781 End If
0782 End If
0783 End If
0784 Else
0785 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0786 End If
0787 rsTableControl.MoveNext
0788 Loop
0789 rsTableToRead.MoveNext
0790 strCol1Break_Last = strCol1Break
0791 i = i + 1
0792Loop
0793'Final Page Footer
0794 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;"
0795Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0796rsTableControl.MoveFirst
0797Do While Not rsTableControl.EOF
0798 Time_Stamp = rsTableControl.Fields(0) & ""
0799 OK = Replace_Timestamp(Time_Stamp)
0800 tsTextFile.WriteLine Time_Stamp
0801 rsTableControl.MoveNext
0802Loop
0803TheEnd:
0804'Copy page to Transfer directory
0805 OK = CopyToTransfer(strFolder, strFileName)
0806 OK = CopyToTransfer(strFolder, strOutputFileShort & strFileSuffix & ".htm")
0807'Clearout
0808Set tsTextFile = Nothing
0809Set fsoTextFile = Nothing
0810Set tsTextFile = Nothing
0811Set tsJumpFile2 = Nothing
0812Set tsJumpFile3 = Nothing
0813Set rsAbstractQuality = Nothing
0814Set rsTableToRead = Nothing
0815Set rsTableToReadLetters = Nothing
0816Set rsTableToReadJump2 = Nothing
0817Set rsTableToReadJump3 = Nothing
0818Set rsTableToReadJump4 = Nothing
0819Set rsTableControl = Nothing
0820Set rsTableControl2 = Nothing
0821Set rsTableControl3 = Nothing
0822Set rsTableControl_BB = Nothing
0823End Sub

Procedures Calling This Procedure (CreatePapersWebTable) Procedures Called By This Procedure (CreatePapersWebTable) Tables / Queries / Fragments Directly Used By This Procedure (CreatePapersWebTable) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Find_Master_Notes
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 49
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Find_Master_Notes()
0002Dim rsNotes As Recordset
0003Dim rsTopNotes As Recordset
0004Dim rsNextNote As Recordset
0005Dim strLine As String
0006Dim Master_Note As Long
0007Dim Master_Note_Found As String
0008'Read the Notes
0009 strLine = "SELECT Notes.ID, Notes.Master_Note FROM Notes ORDER BY Notes.ID;"
0010Set rsNotes = CurrentDb.OpenRecordset(strLine)
0011rsNotes.MoveFirst
0012'Initialise the output file
0013 strLine = "DELETE Master_Notes.* FROM Master_Notes;"
0014DoCmd.RunSQL (strLine)
0015 strLine = "SELECT Master_Notes.* FROM Master_Notes;"
0016Set rsTopNotes = CurrentDb.OpenRecordset(strLine)
0017'Determine the Master_Notes
0018Do While Not rsNotes.EOF
0019 'Is this already a Master Note?
0020 If rsNotes.Fields(1).Value & "" = "" Or rsNotes.Fields(1).Value = 0 Then
0021 Master_Note = rsNotes.Fields(0).Value 'This Note is it's own Master
0022 Else
0023 'Iterate to find the Master Note
0024 Master_Note_Found = "No"
0025 Master_Note = rsNotes.Fields(1) & ""
0026 'Need fix for Notes accidentall having themselves as a master Note.
0027 Do While Master_Note_Found = "No"
0028 strLine = "SELECT Notes.Master_Note FROM Notes WHERE (((Notes.ID) = " & Master_Note & ")) ORDER BY Notes.ID;"
0029 Set rsNextNote = CurrentDb.OpenRecordset(strLine)
0030 rsNextNote.MoveFirst
0031 If rsNextNote.Fields(0).Value & "" = "" Or rsNextNote.Fields(0).Value = 0 Then
0032 Master_Note_Found = "Yes"
0033 Else
0034 Master_Note = rsNextNote.Fields(0).Value
0035 End If
0036 Loop
0037 End If
0038 'Add to Master_Notes table
0039 rsTopNotes.AddNew
0040 rsTopNotes.Fields(0) = rsNotes.Fields(0).Value
0041 rsTopNotes.Fields(1) = Master_Note
0042 rsTopNotes.Update
0043 'Around we go
0044 rsNotes.MoveNext
0045Loop
0046Set rsNotes = Nothing
0047Set rsTopNotes = Nothing
0048Set rsNextNote = Nothing
0049End Sub

Procedures Calling This Procedure (Find_Master_Notes) Tables / Queries / Fragments Directly Used By This Procedure (Find_Master_Notes) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Import_Data
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 32
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Import_Data()
0002Dim rst As Recordset
0003Dim db As Database
0004Dim FromFileName As String
0005Dim ToFileName As String
0006Dim PathName As String
0007Dim fs As Object
0008Dim ExcelApp As Excel.Application
0009PathName = "C:\Theo's Files\Birkbeck\Philosophers_Index\"
0010Set db = CurrentDb
0011 Set rst = db.OpenRecordset("SELECT Import_Files.File_Name FROM Import_Files ORDER BY Import_Files.File_Name DESC;")
0012rst.MoveFirst
0013Set fs = CreateObject("Scripting.FileSystemObject")
0014Do While Not rst.EOF
0015 FromFileName = PathName & "Excel\" & rst.Fields(0) & ".xls"
0016 ToFileName = PathName & "Import\" & "PhilosophersIndex.xls"
0017 If Dir(ToFileName) <> "" Then
0018 Kill ToFileName
0019 End If
0020 fs.CopyFile FromFileName, ToFileName
0021 Set ExcelApp = Excel.Application
0022 ExcelApp.Workbooks.Open (ToFileName)
0023 DoCmd.OpenQuery ("Add_To_Philosophers_Index_Converted")
0024 ExcelApp.ActiveWorkbook.Save
0025 ExcelApp.ActiveWorkbook.Close
0026 ExcelApp.Workbooks.Close
0027 ExcelApp.Quit
0028 ExcelApp.Quit
0029 Set ExcelApp = Nothing
0030 rst.MoveNext
0031Loop
0032End Sub

Tables / Queries / Fragments Directly Used By This Procedure (Import_Data) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: JumpTableTitles
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 204
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub JumpTableTitles(Optional Run_Type)
0002Dim strControlQuery As String
0003Dim rsTableControl2 As Recordset
0004Dim rsTableToReadLetters As Recordset
0005Dim rsMasterNote As Recordset
0006Dim strLetter As String
0007Dim strLetter_Title As String
0008Dim strLine As String
0009Dim x As Integer
0010Dim Y As String
0011Dim fsoTextFile As FileSystemObject
0012Dim Title_Loc As Integer
0013Dim strQuery As String
0014Dim Note_Subdirectory As String
0015Dim i As Long
0016Dim Add_Colours As Boolean
0017Dim strColour
0018If IsMissing(Run_Type) Then
0019 Set fsoTextFile = New FileSystemObject
0020 Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFile & ".htm", True, True)
0021End 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;"
0025Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0026rsTableControl2.MoveFirst
0027Do 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 & "<p><b>Note-Group Purpose: </b>" & Notes_Group_Narrative & "</p>"
0034 End If
0035 strLine = strLine & "<p><a href=""#Colours"">Click here</a> for the explanation of the colouration in the table below. </p>"
0036 End If
0037 tsTextFile.WriteLine strLine
0038 rsTableControl2.MoveNext
0039Loop
0040Add_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;"
0043Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0044rsTableControl2.MoveFirst
0045If 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;"
0052Else
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;"
0055End If
0056Set rsTableToReadLetters = CurrentDb.OpenRecordset(strQuery)
0057If Not rsTableToReadLetters.EOF Then
0058 rsTableToReadLetters.MoveFirst
0059End If
0060If 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 = "<span title=""" & rsTableToReadLetters.Fields(2) & """>" & strLetter_Title & "</span>" '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 = "<A HREF=""#Section" & Replace(strLetter_Title, " ", "_") & """>" & strLetter_Title & "</A>"
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 = "<A HREF=""#InternalHyperlink_Note_" & strLetter & """>" & strLetter_Title & "</A>"
0115 Else
0116 Y = "<A HREF=""" & Note_Subdirectory & strTargetFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0117 End If
0118 End If
0119 Else
0120 Y = "&nbsp;"
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
0151End 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;"
0154Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0155rsTableControl2.MoveFirst
0156Do 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
0165Loop
0166'Add the colour-code table
0167 strLine = "<a name=""Colours""></a><p><b>Note Qualities: </b> 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. </p>"
0168tsTextFile.WriteLine strLine
0169strLine = "<TABLE class=""BridgeColLeft"" WIDTH=750>"
0170tsTextFile.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;"
0172Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0173rsTableControl2.MoveFirst
0174Do While Not rsTableControl2.EOF
0175 strLine = rsTableControl2.Fields(0) & ""
0176 strLine = "<tr><td width=""30%"" align=left bgcolor=""#" & rsTableControl2.Fields(1) & """>" & strLine & "</td>"
0177 tsTextFile.WriteLine strLine
0178 strLine = rsTableControl2.Fields(2) & ""
0179 strLine = "<td width=""70%"" align=left>" & strLine & "&nbsp;</td></tr>"
0180 tsTextFile.WriteLine strLine
0181 rsTableControl2.MoveNext
0182Loop
0183strLine = "</TABLE>"
0184tsTextFile.WriteLine strLine
0185'Extra Footer
0186If 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
0197End If
0198If IsMissing(Run_Type) Then
0199 OK = CopyToTransfer(strFolder, strFileName)
0200 Set tsTextFile = Nothing
0201End If
0202Set rsTableControl2 = Nothing
0203Set rsTableToReadLetters = Nothing
0204End Sub

Procedures Calling This Procedure (JumpTableTitles) Procedures Called By This Procedure (JumpTableTitles) Tables / Queries / Fragments Directly Used By This Procedure (JumpTableTitles) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: JumpTableTitles_Recent_Control
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 175
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub JumpTableTitles_Recent_Control()
0002Dim strControlQuery As String
0003Dim rsTableControl2 As Recordset
0004Dim rsTableToRead As Recordset
0005Dim rsPaperAbstracts As Recordset
0006Dim strLetter As String
0007Dim strLetter_Title As String
0008Dim strLine As String
0009Dim x As Integer
0010Dim Y As String
0011Dim fsoTextFile As FileSystemObject
0012Dim tsTextFile As TextStream
0013Dim Title_Loc As Integer
0014Dim strDirectory As String
0015Dim Record_Count As Integer
0016Dim 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;"
0018Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0019For 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 = "C:\Theo's Files\Websites\Theo's Website\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 = "<A HREF=""" & strDirectory & strTargetFileShort & "_" & strLetter & IIf(Notes_Recent > 0, "_Recent_" & Notes_Recent * 7, "") & ".htm"">" & strLetter_Title & "</A>"
0081 Else
0082 Y = "&nbsp;"
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. <BR><BR>"
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 = "<B><U>Papers addressed or Abstracts Updated in the last " & Notes_Recent * 7 & " days</B></U><UL TYPE=""DISC"">"
0130 tsTextFile.WriteLine strLine
0131 'Rows
0132 Do While Not rsPaperAbstracts.EOF
0133 strLine = "<LI><A HREF = ""../Abstracts/Abstract_" & Right(Int(rsPaperAbstracts.Fields(1) / 1000) + 100, 2) & "/Abstract_" & rsPaperAbstracts.Fields(1) & ".htm"">" & rsPaperAbstracts.Fields(0) & "</A></li>"
0134 tsTextFile.WriteLine strLine
0135 rsPaperAbstracts.MoveNext
0136 Loop
0137 strLine = "</UL><BR>"
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 = "<B><U>Books addressed or Updated in the last " & Notes_Recent * 7 & " days</B></U><UL TYPE=""DISC"">"
0146 tsTextFile.WriteLine strLine
0147 'Rows
0148 Do While Not rsPaperAbstracts.EOF
0149 strLine = "<LI><A HREF = ""../BookSummaries/BookSummary_" & Right(Int(rsPaperAbstracts.Fields(1) / 1000) + 100, 2) & "/BookPaperAbstracts/BookPaperAbstracts_" & rsPaperAbstracts.Fields(1) & ".htm"">" & rsPaperAbstracts.Fields(0) & "</A></li>"
0150 tsTextFile.WriteLine strLine
0151 rsPaperAbstracts.MoveNext
0152 Loop
0153 strLine = "</UL><BR>"
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
0171Next Notes_Recent
0172Set rsTableControl2 = Nothing
0173Set rsTableToRead = Nothing
0174Set tsTextFile = Nothing
0175End Sub

Procedures Calling This Procedure (JumpTableTitles_Recent_Control) Procedures Called By This Procedure (JumpTableTitles_Recent_Control) Tables / Queries / Fragments Directly Used By This Procedure (JumpTableTitles_Recent_Control) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



© Theo Todman, June 2007 - August 2021. Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Philosophy Page Return to Theo Todman's Home Page