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: 825
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 rsBookAbstract As Recordset
0022Dim strControlQuery As String
0023Dim strAbstractQualityQuery As String
0024Dim strLine As String
0025Dim strQuery As String
0026Dim iTableColumns As Integer
0027Dim iFieldNo As Integer
0028Dim iIDCol As Integer
0029Dim x As Integer
0030Dim Y As String
0031Dim z As String
0032Dim z1 As String
0033Dim z2 As String
0034Dim strLetter As String
0035Dim strLetter_Title As String
0036Dim strControlBreak As String
0037Dim strControlBreak_Last As String
0038Dim strCol1Break As String
0039Dim strCol1Break_Last As String
0040Dim strLine_SavedHeader As String
0041Dim strLine_SavedFooter As String
0042Dim i As Integer
0043Dim strLetter_Title_Short As String
0044Dim strLetter_Title2 As String
0045Dim Jump_type As Integer
0046Dim File_Suffix As String
0047Dim start As Date
0048Dim strNextPageQuery As String
0049Dim NextPage As String
0050Dim NextPageID As String
0051Dim LeftLink As String
0052Dim RightLink As String
0053Dim LinkTable As String
0054Dim Toplink As String
0055Dim MaxLen As Integer
0056Dim Time_Stamp As String
0057Dim RightPct As Integer
0058Dim LeftPct As Integer
0059Dim RightLen As Integer
0060Dim LeftLen As Integer
0061start = Now()
0062Set fsoTextFile = New FileSystemObject
0063'Create Control File
0064strFolder = strOutputFolder
0065strFileName = strOutputFileShort & ".htm"
0066Set tsTextFile = fsoTextFile.CreateTextFile(strFolder & strFileName, True, True)
0067strLine_SavedHeader = ""
0068'Find Footer for BB Pages
0069strLine_SavedFooter = ""
0070 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;"
0071Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0072rsTableControl.MoveFirst
0073Do While Not rsTableControl.EOF
0074 strLine_SavedFooter = strLine_SavedFooter & rsTableControl.Fields(0)
0075 rsTableControl.MoveNext
0076Loop
0077 OK = Replace_Timestamp(strLine_SavedFooter)
0078'Control Page Header
0079If Main_Header = "Yes" Then
0080 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;"
0081Else
0082 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;"
0083End If
0084Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0085rsTableControl.MoveFirst
0086Do While Not rsTableControl.EOF
0087 strLine = rsTableControl.Fields(0) & ""
0088 x = InStr(1, strLine, "**TITLE_HEAD**")
0089 If x > 0 Then
0090 strLine = Left(strLine, x - 1) & Mid(strLine, x + 15, Len(strLine))
0091 End If
0092 x = InStr(1, strLine, "**SECTION**")
0093 If x > 0 Then
0094 'Set up the "jump" table
0095 If strControlBreakType2 = "BB" Then
0096 strLine = "<BR><P ALIGN = ""Left""><FONT Size = 2 FACE=""Arial"">"
0097 tsTextFile.WriteLine strLine
0098 'Re-create the BB_Control table
0099 DoCmd.OpenQuery ("BB_Control_Zap")
0100 DoCmd.OpenQuery (strDataQuery & " (ControlGEN)")
0101 BB_Control_GEN
0102 'Level 1 jump
0103 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;"
0104 Set rsTableToReadLetters = CurrentDb.OpenRecordset(strControlQuery)
0105 rsTableToReadLetters.MoveFirst
0106 strLine = "<B><U>Level 1 Jump</B></U><BR><BR>"
0107 tsTextFile.WriteLine strLine
0108 Do While Not rsTableToReadLetters.EOF
0109 strLine = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & ".htm"">" & rsTableToReadLetters.Fields(1) & " - " & rsTableToReadLetters.Fields(2) & "</A><BR>"
0110 tsTextFile.WriteLine strLine
0111 rsTableToReadLetters.MoveNext
0112 Loop
0113 strLine = strLine_SavedFooter
0114 tsTextFile.WriteLine strLine
0115 'Level 2 jump
0116 rsTableToReadLetters.MoveFirst
0117 Do While Not rsTableToReadLetters.EOF
0118 Set tsJumpFile = fsoTextFile.CreateTextFile(strOutputFile & "_" & rsTableToReadLetters.Fields(0) & ".htm", True, True)
0119 strLine = strLine_SavedHeader & "<BR><B><U>Level 2 Jump</B></U><BR><BR>"
0120 tsJumpFile.WriteLine strLine
0121 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;"
0122 Set rsTableToReadJump2 = CurrentDb.OpenRecordset(strControlQuery)
0123 rsTableToReadJump2.MoveFirst
0124 Do While Not rsTableToReadJump2.EOF
0125 strLine = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & ".htm"">" & rsTableToReadJump2.Fields(1) & " - " & rsTableToReadJump2.Fields(2) & "</A><BR>"
0126 tsJumpFile.WriteLine strLine
0127 'Level 3 Jump
0128 Set tsJumpFile2 = fsoTextFile.CreateTextFile(strOutputFile & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & ".htm", True, True)
0129 strLine = strLine_SavedHeader & "<BR><B><U>Level 3 Jump</B></U><BR><BR>"
0130 tsJumpFile2.WriteLine strLine
0131 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) & "));"
0132 Set rsTableToReadJump3 = CurrentDb.OpenRecordset(strControlQuery)
0133 rsTableToReadJump3.MoveFirst
0134 Do While Not rsTableToReadJump3.EOF
0135 strLine = "<A HREF=""" & strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & ".htm"">" & rsTableToReadJump3.Fields(1) & " - " & rsTableToReadJump3.Fields(2) & "</A><BR>"
0136 tsJumpFile2.WriteLine strLine
0137 'Level 4 Jump
0138 Set tsJumpFile3 = fsoTextFile.CreateTextFile(strOutputFile & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & ".htm", True, True)
0139 strLine = strLine_SavedHeader & "<BR><B><U>Level 4 Jump</B></U><BR><BR>"
0140 tsJumpFile3.WriteLine strLine
0141 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;"
0142 Set rsTableToReadJump4 = CurrentDb.OpenRecordset(strControlQuery)
0143 rsTableToReadJump4.MoveFirst
0144 Do While Not rsTableToReadJump4.EOF
0145 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>"
0146 tsJumpFile3.WriteLine strLine
0147 rsTableToReadJump4.MoveNext
0148 Loop
0149 strLine = strLine_SavedFooter
0150 tsJumpFile3.WriteLine strLine
0151 OK = CopyToTransfer(strFolder, strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & "_" & rsTableToReadJump3.Fields(0) & ".htm")
0152 Set tsJumpFile3 = Nothing
0153 Set rsTableToReadJump4 = Nothing
0154 rsTableToReadJump3.MoveNext
0155 Loop
0156 strLine = strLine_SavedFooter
0157 tsJumpFile2.WriteLine strLine
0158 OK = CopyToTransfer(strFolder, strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & "_" & rsTableToReadJump2.Fields(0) & ".htm")
0159 Set tsJumpFile2 = Nothing
0160 Set rsTableToReadJump3 = Nothing
0161 rsTableToReadJump2.MoveNext
0162 Loop
0163 strLine = strLine_SavedFooter
0164 tsJumpFile.WriteLine strLine
0165 OK = CopyToTransfer(strFolder, strOutputFileShort & "_" & rsTableToReadLetters.Fields(0) & ".htm")
0166 rsTableToReadLetters.MoveNext
0167 Set tsJumpFile = Nothing
0168 Set rsTableToReadJump2 = Nothing
0169 Loop
0170 Set rsTableToReadLetters = Nothing
0171 Else
0172 If strControlBreakType = "Initial" Then 'Initial-letter jump table
0173 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;"
0174 Set rsTableControl2 = CurrentDb.OpenRecordset(strControlQuery)
0175 rsTableControl2.MoveFirst
0176 Set rsTableToReadLetters = CurrentDb.OpenRecordset(strDataQuery & " (Letters)")
0177 rsTableToReadLetters.MoveFirst
0178 strLetter = rsTableToReadLetters.Fields(0)
0179 Do While Not rsTableControl2.EOF
0180 strLine = rsTableControl2.Fields(0) & ""
0181 x = InStr(1, strLine, "**Column")
0182 If x > 0 Then
0183 Y = Mid(strLine, x + 8, 1)
0184 If Y < strLetter Then
0185 strLine = Left(strLine, x - 1) & "." & Mid(strLine, x + 11, Len(strLine))
0186 Else
0187 If strSplitTable = "No" Then
0188 Y = "<A HREF=""#Section" & Y & """>" & Y & "</A>"
0189 Else
0190 Y = "<A HREF=""" & strOutputFileShort & "_" & Y & ".htm"">" & Y & "</A>"
0191 End If
0192 strLine = Left(strLine, x - 1) & Y & Mid(strLine, x + 11, Len(strLine))
0193 If Not rsTableToReadLetters.EOF Then
0194 rsTableToReadLetters.MoveNext
0195 If Not rsTableToReadLetters.EOF Then
0196 strLetter = Left(rsTableToReadLetters.Fields(0), 1)
0197 Else
0198 strLetter = "ZZZ"
0199 End If
0200 End If
0201 End If
0202 tsTextFile.WriteLine strLine
0203 Else
0204 tsTextFile.WriteLine strLine
0205 End If
0206 rsTableControl2.MoveNext
0207 Loop
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, "<BR>") > 0 Then
0256 strLetter_Title_Short = Left(strLetter_Title, InStr(strLetter_Title, "<BR>") - 1)
0257 Else
0258 strLetter_Title_Short = strLetter_Title
0259 End If
0260 Y = "<A HREF=""#Section" & Replace(strLetter_Title_Short, " ", "_") & """>" & strLetter_Title & "</A>"
0261 Else
0262 If strControlBreakType2 = "2-Level" Then
0263 If Jump_type = 2 Then
0264 Y = "<A HREF=""" & strOutputFileShort & "_Top_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0265 Else
0266 File_Suffix = strLetter
0267 Y = "<A HREF=""" & strOutputFileShort & "_" & File_Suffix & ".htm"">" & strLetter_Title & "</A>"
0268 End If
0269 Else
0270 Y = "<A HREF=""" & strOutputFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
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), "<BR>") - 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, "<BR>", " ")
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: <a href=""" & strOutputFileShort & "_Top_" & strFileSuffix_Previous & ".htm"">" & strFileTitle_Previous & "</a>")
0355 LeftLen = IIf(strFileSuffix_Previous = "", Len("Previous Page: None"), Len("Previous Page: " & strFileTitle_Previous))
0356 RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: <a href=""" & strOutputFileShort & "_" & NextPageID & ".htm"">" & NextPage & "</a>")
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 = "<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>"
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, "<BR>") > 0 Then
0412 strLetter_Title_Short = Left(strLetter_Title, InStr(strLetter_Title, "<BR>") - 1)
0413 Else
0414 strLetter_Title_Short = strLetter_Title
0415 End If
0416 Y = "<A HREF=""#Section" & Replace(strLetter_Title_Short, " ", "_") & """>" & strLetter_Title & "</A>"
0417 Else
0418 If strControlBreakType2 = "2-Level" Then
0419 Y = "<A HREF=""" & strOutputFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
0420 Else
0421 Y = "<A HREF=""" & strOutputFileShort & "_" & strLetter & ".htm"">" & strLetter_Title & "</A>"
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 "<center>"
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
0478Loop
0479DataRead:
0480'Read the data
0481Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery)
0482iIDCol = rsTableToRead.Fields.Count 'Log the last column number (which contains the record ID)
0483rsTableToRead.MoveFirst
0484strControlBreak = Left(rsTableToRead.Fields(0) & "", 1)
0485'Force a control-break
0486strControlBreak_Last = "@"
0487iTableColumns = rsTableToRead.Fields.Count
0488strFileSuffix = ""
0489strFileTitle = ""
0490If strSplitTable = "No" Then 'This is for tables that don't split across web-pages, so have intermediate control breaks
0491 'Read Table-Control for rows
0492 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;"
0493 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0494 If strControlBreakType = "xInitial" Then 'This has been disabled ... remove if proved not to be needed
0495 'Table Column Headings
0496 rsTableControl.MoveFirst
0497 Do While Not rsTableControl.EOF
0498 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0499 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0500 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0501 tsTextFile.WriteLine "<strong> " & rsTableToRead.Fields(iFieldNo - 1).Name & "</strong>"
0502 End If
0503 Else
0504 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0505 End If
0506 rsTableControl.MoveNext
0507 Loop
0508 End If
0509End If
0510z = rsTableToRead.Fields(0).Name
0511z1 = rsTableToRead.Fields(iTableColumns - 2).Name
0512Do Until rsTableToRead.EOF
0513 strFileSuffix_Previous = strFileSuffix
0514 strFileTitle_Previous = strFileTitle
0515 If strControlBreakType2 = "BB" Then
0516 strFileSuffix = "_" & rsTableToRead.Fields(2) & ""
0517 Else
0518 If strSplitTable = "No" Then
0519 strFileSuffix = ""
0520 Else
0521 If strControlBreakType = "Initial" Then
0522 strFileSuffix = "_" & UCase(Left(rsTableToRead.Fields(0) & "", 1))
0523 Else
0524 strFileSuffix = "_" & rsTableToRead.Fields(iTableColumns - 2) & ""
0525 strFileTitle = rsTableToRead.Fields(0) & ""
0526 End If
0527 End If
0528 End If
0529 If strFileSuffix_Previous <> strFileSuffix Then
0530 'Write the previous Footer
0531 If strFileSuffix_Previous <> "" Then
0532 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;"
0533 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0534 rsTableControl.MoveFirst
0535 Do While Not rsTableControl.EOF
0536 Time_Stamp = rsTableControl.Fields(0) & ""
0537 OK = Replace_Timestamp(Time_Stamp)
0538 tsTextFile.WriteLine Time_Stamp
0539 rsTableControl.MoveNext
0540 Loop
0541 OK = CopyToTransfer(strFolder, strOutputFileShort & strFileSuffix_Previous & ".htm")
0542 End If
0543 'Create File
0544 Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFile & strFileSuffix & ".htm", True, True)
0545 'Page Header
0546 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;"
0547 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0548 rsTableControl.MoveFirst
0549 Do While Not rsTableControl.EOF
0550 strLine = rsTableControl.Fields(0) & ""
0551 x = InStr(1, strLine, "**TITLE_HEAD**")
0552 If x > 0 Then
0553 If strControlBreakType2 = "BB" Then
0554 strLine = Left(strLine, x - 1) & "Section: " & rsTableToRead.Fields(3) & " - " & Mid(strLine, x + 14, Len(strLine))
0555 Else
0556 If strSplitTable = "No" Then
0557 strLine = Left(strLine, x - 1) & Mid(strLine, x + 15, Len(strLine))
0558 Else
0559 If strControlBreakType = "Initial" Then
0560 strLine = Left(strLine, x - 1) & "Section: " & Right(strFileSuffix, 1) & " - " & Mid(strLine, x + 14, Len(strLine))
0561 Else
0562 strLine = Left(strLine, x - 1) & "Section: " & rsTableToRead.Fields(0) & " - " & Mid(strLine, x + 14, Len(strLine))
0563 End If
0564 End If
0565 End If
0566 End If
0567 x = InStr(1, strLine, "**SECTION**")
0568 If x > 0 Then
0569 If strControlBreakType2 = "BB" Then
0570 strLine = Left(strLine, x - 1) & rsTableToRead.Fields(3) & Mid(strLine, x + 11, Len(strLine))
0571 Else
0572 If strSplitTable = "No" Then
0573 strLine = Left(strLine, x - 1) & "A-Z" & Mid(strLine, x + 11, Len(strLine))
0574 Else
0575 If strControlBreakType = "Initial" Then
0576 strLine = Left(strLine, x - 1) & Right(strFileSuffix, 1) & Mid(strLine, x + 11, Len(strLine))
0577 'Find Next page
0578 strNextPageQuery = "SELECT [" & strDataQuery & " (Letters)].* FROM [" & strDataQuery & " (Letters)];"
0579 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0580 rsTableControl3.MoveFirst
0581 z = rsTableControl3.Fields(0).Name
0582 strNextPageQuery = "SELECT [" & strDataQuery & " (Letters)].[" & z & "] FROM [" & strDataQuery & " (Letters)] WHERE ((([" & strDataQuery & " (Letters)].[" & z & "])>""" & rsTableToRead.Fields(0).Value & """)) ORDER BY [" & strDataQuery & " (Letters)].[" & z & "];"
0583 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0584 If rsTableControl3.EOF Then
0585 NextPage = ""
0586 NextPageID = ""
0587 Else
0588 rsTableControl3.MoveFirst
0589 NextPage = rsTableControl3.Fields(0)
0590 End If
0591 LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: <a href=""" & strOutputFileShort & strFileSuffix_Previous & ".htm"">" & Right(strFileSuffix_Previous, 1) & "</a>")
0592 RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: <a href=""" & strOutputFileShort & "_" & NextPage & ".htm"">" & NextPage & "</a>")
0593 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>"
0594 strLine = strLine & LinkTable
0595 Else
0596 strLine = Left(strLine, x - 1) & ": " & rsTableToRead.Fields(0) & Mid(strLine, x + 11, Len(strLine))
0597 'Find Next page
0598 strNextPageQuery = "SELECT [" & strDataQuery & "].[" & z & "], [" & strDataQuery & "].[" & z1 & "] FROM [" & strDataQuery & "] WHERE ((([" & strDataQuery & "].[" & z & "])>""" & rsTableToRead.Fields(0).Value & """)) ORDER BY [" & strDataQuery & "].[" & z & "];"
0599 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0600 If rsTableControl3.EOF Then
0601 NextPage = ""
0602 NextPageID = ""
0603 Else
0604 rsTableControl3.MoveFirst
0605 NextPage = rsTableControl3.Fields(0)
0606 NextPageID = rsTableControl3.Fields(1)
0607 End If
0608 LeftLink = IIf(strFileSuffix_Previous = "", "Previous Page: None", "Previous Page: <a href=""" & strOutputFileShort & strFileSuffix_Previous & ".htm"">" & strFileTitle_Previous & "</a>")
0609 LeftLen = IIf(strFileSuffix_Previous = "", Len("Previous Page: None"), Len("Previous Page: " & strFileTitle_Previous))
0610 RightLink = IIf(NextPage = "", "Next Page: None", "Next Page: <a href=""" & strOutputFileShort & "_" & NextPageID & ".htm"">" & NextPage & "</a>")
0611 RightLen = IIf(NextPage = "", Len("Next Page: None"), Len("Next Page: " & NextPage))
0612 If LeftLen > RightLen Then
0613 MaxLen = LeftLen
0614 Else
0615 MaxLen = RightLen
0616 End If
0617 MaxLen = 200 + 15 * MaxLen
0618 If MaxLen > 950 Then
0619 LeftPct = Round((LeftLen + 100 / 8) / (LeftLen + RightLen + 200 / 8) * 100, 0)
0620 RightPct = 100 - LeftPct
0621 MaxLen = 200 + (LeftLen + RightLen) * 8
0622 Else
0623 LeftPct = 50
0624 RightPct = 50
0625 End If
0626 'Find next level up (if there is one)
0627 If InStr(2, strFileSuffix, "_") > 0 Then
0628 If InStr(rsTableToRead.Fields(0), " - ") > 0 Then
0629 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>"
0630 Else
0631 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>"
0632 End If
0633 'Check for solitons
0634 On Error Resume Next
0635 strNextPageQuery = "SELECT [" & strDataQuery & " (Titles) - Solitons].[ID] FROM [" & strDataQuery & " (Titles) - Solitons] WHERE ((([" & strDataQuery & " (Titles) - Solitons].[ID])=""" & Mid(strFileSuffix, 2, 100) & """));"
0636 Set rsTableControl3 = CurrentDb.OpenRecordset(strNextPageQuery)
0637 If rsTableControl3.EOF Then
0638 Else
0639 Toplink = ""
0640 End If
0641 On Error GoTo 0
0642 Else
0643 Toplink = ""
0644 End If
0645 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>"
0646 strLine = strLine & LinkTable
0647 End If
0648 End If
0649 End If
0650 End If
0651 tsTextFile.WriteLine strLine
0652 rsTableControl.MoveNext
0653 Loop
0654 'Read Table-Control for rows
0655 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;"
0656 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0657 If strControlBreakType2 = "BB" Then
0658 'Write out the 2nd Jump List
0659 strControlQuery = "SELECT [" & strDataQuery & " (Breaks)].Break FROM [" & strDataQuery & " (Breaks)] WHERE ((([" & strDataQuery & " (Breaks)].Suffix)=""" & Mid(strFileSuffix, 2, Len(strFileSuffix)) & """));"
0660 Set rsTableControl_BB = CurrentDb.OpenRecordset(strControlQuery)
0661 If Not rsTableControl_BB.EOF Then
0662 rsTableControl_BB.MoveFirst
0663 Do While Not rsTableControl_BB.EOF
0664 tsTextFile.WriteLine "<A HREF=""#" & rsTableControl_BB.Fields(0) & """>" & rsTableControl_BB.Fields(0) & "</A><BR>"
0665 rsTableControl_BB.MoveNext
0666 Loop
0667 tsTextFile.WriteLine "<BR><BR><HR>"
0668 strCol1Break_Last = ""
0669 i = 1
0670 tsTextFile.WriteLine "<P ALIGN=""Left""><FONT Size = 2 FACE=""Arial"">"
0671 End If
0672 Else
0673 'Table Column Headings
0674 rsTableControl.MoveFirst
0675 Do While Not rsTableControl.EOF
0676 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0677 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0678 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0679 tsTextFile.WriteLine "<B> " & rsTableToRead.Fields(iFieldNo - 1).Name & "</B>"
0680 End If
0681 Else
0682 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0683 End If
0684 rsTableControl.MoveNext
0685 Loop
0686 End If
0687 End If
0688 'Internal Control Breaks
0689 If strControlBreakType = "Initial" Then
0690 strControlBreak = Left(rsTableToRead.Fields(0), 1)
0691 Else
0692 strControlBreak = Replace(rsTableToRead.Fields(0) & "", " ", "_")
0693 End If
0694 If strControlBreak_Last <> strControlBreak Then
0695 If strSplitTable = "No" Then
0696 'Add an internal table break + reference
0697 tsTextFile.WriteLine "</TABLE><a name=""Section" & Replace(strControlBreak, " ", "_") & """></a><h3>SECTION: " & Replace(strControlBreak, "_", " ") & "</h3><TABLE class = ""ReadingList"" WIDTH=950>"
0698 'Table Column Headings
0699 rsTableControl.MoveFirst
0700 Do While Not rsTableControl.EOF
0701 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0702 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0703 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0704 tsTextFile.WriteLine "<B> " & rsTableToRead.Fields(iFieldNo - 1).Name & "</B>"
0705 End If
0706 Else
0707 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0708 End If
0709 rsTableControl.MoveNext
0710 Loop
0711 End If
0712 strControlBreak_Last = strControlBreak
0713 End If
0714 'Table Row
0715 rsTableControl.MoveFirst
0716 Do While Not rsTableControl.EOF
0717 If Left(rsTableControl.Fields(0), 8) = "**Column" Then
0718 If strControlBreakType2 = "BB" Then
0719 strCol1Break = rsTableToRead.Fields(0)
0720 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0721 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0722 If iFieldNo = 1 Then
0723 If strCol1Break <> strCol1Break_Last Then
0724 strLine = "<A NAME=""" & strCol1Break & """></A><BR><B><U>" & strCol1Break & "</U></B><BR>"
0725 tsTextFile.WriteLine strLine
0726 i = 1
0727 End If
0728 Else
0729 If Left(strControlTable, 4) = "Book" Then
0730 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>"
0731 Else
0732 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>"
0733 End If
0734 tsTextFile.WriteLine strLine
0735 End If
0736 End If
0737 Else
0738 iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2))
0739 If iFieldNo > 0 And iFieldNo <= iTableColumns Then
0740 If Len(rsTableToRead.Fields(iFieldNo - 1) & "") = 0 Then
0741 tsTextFile.WriteLine "&nbsp;"
0742 Else
0743 If rsTableToRead.Fields(iFieldNo - 1).Name = "Abstract" Then
0744 'Generate Paper Sumary & Abstract Links
0745 strLine = PaperSumaryAbstract_Links(rsTableToRead.Fields(iFieldNo - 1).Value, rsTableToRead.Fields(iIDCol - 1))
0746 Else
0747 strLine = rsTableToRead.Fields(iFieldNo - 1)
0748 If rsTableToRead.Fields(iFieldNo - 1).Name = "Source" Then
0749 strLine = Remove_Dummy_Ref(strLine)
0750 strLine = WebEncode(strLine)
0751 OK = Reference_Books(strLine, "X", 0, 0, 0)
0752 OK = Reference_Papers(strLine, "X", 0, 0, 0)
0753 OK = Reference_Webrefs(strLine, "X", 0, 0)
0754 Else
0755 If rsTableToRead.Fields(iFieldNo - 1).Name = "Link" Then
0756 If strLine = "**Precis**" Then 'Comments that were null, or (most likely) contained part of the precis
0757 strLine = ""
0758 Else
0759 strLine = Replace(strLine, "../", "")
0760 End If
0761 strLine = Remove_Dummy_Ref(strLine)
0762 strLine = WebEncode(strLine)
0763 OK = Reference_Books(strLine, "X", 0, 0, 0)
0764 OK = Reference_Papers(strLine, "X", 0, 0, 0)
0765 OK = Reference_Notes(strLine, "X", 0, 0, 0)
0766 OK = Reference_Notes(strLine, "X", 0, 0, 0, "Abstract_Direct")
0767 OK = Reference_Webrefs(strLine, "X", 0, 0)
0768 strLine = NumberedBullets(strLine)
0769 strLine = Bullets(strLine)
0770 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>"
0771 If Len(strLine) > 500 Then
0772 strLine = "Précis link too long - follow above link to Abstract"
0773 End If
0774 Else
0775 If rsTableToRead.Fields(iFieldNo - 1).Name = "Author" Then
0776 OK = Author_Reference_String(strLine, 0)
0777 End If
0778 End If
0779 End If
0780 End If
0781 strLine = Replace(strLine, Chr(13) & Chr(10), "<BR>")
0782 tsTextFile.WriteLine strLine
0783 End If
0784 End If
0785 End If
0786 Else
0787 tsTextFile.WriteLine rsTableControl.Fields(0) & ""
0788 End If
0789 rsTableControl.MoveNext
0790 Loop
0791 rsTableToRead.MoveNext
0792 strCol1Break_Last = strCol1Break
0793 i = i + 1
0794Loop
0795'Final Page Footer
0796 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;"
0797Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0798rsTableControl.MoveFirst
0799Do While Not rsTableControl.EOF
0800 Time_Stamp = rsTableControl.Fields(0) & ""
0801 OK = Replace_Timestamp(Time_Stamp)
0802 tsTextFile.WriteLine Time_Stamp
0803 rsTableControl.MoveNext
0804Loop
0805TheEnd:
0806'Copy page to Transfer directory
0807 OK = CopyToTransfer(strFolder, strFileName)
0808 OK = CopyToTransfer(strFolder, strOutputFileShort & strFileSuffix & ".htm")
0809'Clearout
0810Set tsTextFile = Nothing
0811Set fsoTextFile = Nothing
0812Set tsTextFile = Nothing
0813Set tsJumpFile2 = Nothing
0814Set tsJumpFile3 = Nothing
0815Set rsAbstractQuality = Nothing
0816Set rsTableToRead = Nothing
0817Set rsTableToReadLetters = Nothing
0818Set rsTableToReadJump2 = Nothing
0819Set rsTableToReadJump3 = Nothing
0820Set rsTableToReadJump4 = Nothing
0821Set rsTableControl = Nothing
0822Set rsTableControl2 = Nothing
0823Set rsTableControl3 = Nothing
0824Set rsTableControl_BB = Nothing
0825End 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 - Dec 2020. Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Philosophy Page Return to Theo Todman's Home Page