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 44 (4 items)

Functor_18Page_Hits_Import_ControlPage_Hits_Page_GenWebpageGenAuthorsSummary

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

Go to top of page



Source Code of: Functor_18
Procedure Type: Public Function
Module: Functors
Lines of Code: 175
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_18(Note_ID, Note_Title, Note_Text, Run_Type)
0002'Create an Aeon file list
0003Dim rs As Recordset
0004Dim rs_PID As Recordset
0005Dim strQuery As String
0006Dim Note_Text_Local As String
0007Dim Read_Type As String
0008Dim List_Title As String
0009Dim List_Blurb As String
0010Dim Row_Text As String
0011Dim strDate As String
0012Dim Author_Names As String
0013Dim Aeon_Author_Narr As String
0014Dim Aeon_Subtitle As String
0015Dim Aeon_Extract As String
0016Dim See_Also As String
0017Dim TT_Notes As String
0018Dim PID_Note_ID As String
0019Dim Paper_ID As String
0020Dim FN_Test_Aeon As String
0021Dim FN_Test_TT As String
0022Dim Priority As Integer
0023Dim Pri_Saved As Integer
0024Dim strDate_Saved As String
0025DoEvents
0026Pri_Saved = 999
0027Select Case Run_Type
0028 Case 1
0029 Read_Type = "Read"
0030 List_Title = "Items Read"
0031 List_Blurb = "<p>Click on the Date for further information and (possibly) a commentary, and on the Title for the full paper on <em>Aeon</em>. </p>"
0032 strQuery = "SELECT Aeon_Files.* FROM Aeon_Files WHERE (((Aeon_Files.Aeon_Note_ID) = " & Note_ID & ") And ((Aeon_Files.[Read?]) = True)) ORDER BY Aeon_Files.Aeon_Date_Published DESC , Aeon_Files.Aeon_Title;"
0033 Case 2
0034 Read_Type = "Un-Read"
0035 List_Title = "Items Not Yet Read"
0036 strQuery = "SELECT Aeon_Files.* FROM Aeon_Files WHERE (((Aeon_Files.Aeon_Note_ID) = " & Note_ID & ") And ((Aeon_Files.[Read?]) = False) And ((Aeon_Files.[Exclude?]) = False)) ORDER BY Aeon_Files.Priority, Aeon_Files.Aeon_Date_Published DESC , Aeon_Files.Date_Created DESC , Aeon_Files.Aeon_Title;"
0037 Case Else
0038 Functor_18 = "No"
0039 Exit Function
0040End Select
0041Set rs = CurrentDb.OpenRecordset(strQuery)
0042If Not rs.EOF Then
0043 rs.MoveFirst
0044Else
0045 Debug.Print Now() & " - "; "Functor 18: No " & " Aeon Files for this Note. Note ID = "; Note_ID
0046 Functor_18 = "No"
0047 Exit Function
0048End If
0049DoEvents
0050'Create list
0051Note_Text_Local = Note_Text & "<a name=""Off-Page_Link_Project_Note_1292_" & Read_Type & """></a>"
0052Note_Text_Local = Note_Text_Local & "<hr><br><u>" & List_Title & "</u>"
0053If Run_Type = 2 Then
0054 Note_Text_Local = Note_Text_Local & "|AA|"
0055Else
0056 Note_Text_Local = Note_Text_Local & "|..|" & List_Blurb
0057End If
0058'Add items to list
0059Do Until rs.EOF
0060 If Run_Type = 2 Then
0061 Priority = rs.Fields(16)
0062 If Priority <> Pri_Saved Then
0063 If Pri_Saved <> 999 Then
0064 Note_Text_Local = Note_Text_Local & "|..|"
0065 End If
0066 Pri_Saved = Priority
0067 Note_Text_Local = Note_Text_Local & "<a name=""Off-Page_Link_Project_Note_1292_Pri_" & Priority & """></a>" & "|1|<b>Priority: " & Priority & "</b>"
0068 Note_Text_Local = Note_Text_Local & "|..|"
0069 End If
0070 End If
0071 Row_Text = "|.|+W" & rs.Fields(0) & "W+"
0072 If rs.Fields(7) > 0 Then
0073 strDate_Saved = rs.Fields(7)
0074 strDate = "|Colour_3|" & strDate_Saved & "|Colour_R|"
0075 Else
0076 strDate = "Undated"
0077 strDate_Saved = strDate
0078 End If
0079 FN_Test_Aeon = ""
0080 FN_Test_TT = ""
0081 Author_Names = rs.Fields(3) & ""
0082 Aeon_Author_Narr = rs.Fields(4) & ""
0083 FN_Test_Aeon = FN_Test_Aeon & Aeon_Author_Narr
0084 Aeon_Subtitle = rs.Fields(6) & ""
0085 Aeon_Extract = rs.Fields(8) & ""
0086 FN_Test_Aeon = FN_Test_Aeon & Aeon_Extract
0087 See_Also = rs.Fields(9) & ""
0088 FN_Test_TT = FN_Test_TT & See_Also
0089 TT_Notes = rs.Fields(10) & ""
0090 FN_Test_TT = FN_Test_TT & TT_Notes
0091 PID_Note_ID = rs.Fields(12) & ""
0092 Paper_ID = rs.Fields(13)
0093 If Paper_ID > 0 Then
0094 strDate = "[" & strDate & "]++FN"
0095 strDate = strDate & "<a name=""Off-Page_Link_FNW" & rs.Fields(0) & "W""></a>"
0096 strDate = strDate & " +W" & rs.Fields(0) & "W+ (Date=" & strDate_Saved & ", WebRef=" & rs.Fields(0) & ")|..||.|This paper is important enough to be logged: See +P" & Paper_ID & "P+.|..|++"
0097 Else
0098 If FN_Test_Aeon & FN_Test_TT <> "" Then
0099 strDate = "[" & strDate & "]++FN"
0100 strDate = strDate & "<a name=""Off-Page_Link_FNW" & rs.Fields(0) & "W""></a>"
0101 strDate = strDate & " +W" & rs.Fields(0) & "W+ (Date=" & strDate_Saved & ", WebRef=" & rs.Fields(0) & ")" & "|99|"
0102 strDate = strDate & "|1|Aeon|..|"
0103 If Author_Names <> "" And Author_Names <> "Video" Then
0104 strDate = strDate & "|.|Author" & IIf(InStr(Author_Names, "&") > 0, "s", "") & ": " & Author_Names
0105 End If
0106 If Aeon_Author_Narr <> "" Then
0107 strDate = strDate & "|.|Author Narrative: |Colour_2|" & Aeon_Author_Narr & "|Colour_R|"
0108 End If
0109 If Aeon_Subtitle <> "" Then
0110 strDate = strDate & "|.|Aeon Subtitle: |Colour_2|" & Aeon_Subtitle & "|Colour_R|"
0111 End If
0112 If Aeon_Extract <> "" Then
0113 strDate = strDate & "|.|" & Aeon_Extract
0114 End If
0115 strDate = strDate & "|..|"
0116 If FN_Test_TT <> "" Then
0117 strDate = strDate & "|1|Notes|..|"
0118 If See_Also <> "" Then
0119 strDate = strDate & "|.|See Also: <br>" & See_Also
0120 End If
0121 If TT_Notes <> "" Then
0122 strDate = strDate & TT_Notes
0123 End If
0124 If PID_Note_ID > "0" Then
0125 strQuery = "SELECT Notes.ID, Notes.Item_Title FROM Notes WHERE (((Notes.ID)=" & Val(PID_Note_ID) & "));"
0126 Set rs_PID = CurrentDb.OpenRecordset(strQuery)
0127 rs_PID.MoveFirst
0128 strDate = strDate & "|.|PID Note: [" & rs_PID.Fields(1) & "]+N" & PID_Note_ID & "N+"
0129 Set rs_PID = Nothing
0130 End If
0131 strDate = strDate & "|..|"
0132 Else
0133 If PID_Note_ID > "0" Then
0134 strDate = strDate & "|1|Notes|..|"
0135 strQuery = "SELECT Notes.ID, Notes.Item_Title FROM Notes WHERE (((Notes.ID)=" & Val(PID_Note_ID) & "));"
0136 Set rs_PID = CurrentDb.OpenRecordset(strQuery)
0137 rs_PID.MoveFirst
0138 strDate = strDate & "|.|PID Note: [" & rs_PID.Fields(1) & "]+N" & PID_Note_ID & "N+"
0139 Set rs_PID = Nothing
0140 strDate = strDate & "|..|"
0141 End If
0142 End If
0143 strDate = strDate & "|99|++"
0144 Else
0145 If strDate = "Undated" Then
0146 strDate = ""
0147 End If
0148 If InStr(Author_Names, "+A") > 0 Then
0149 strDate = strDate & " (" & Author_Names & ")"
0150 End If
0151 If PID_Note_ID > "0" Then
0152 strQuery = "SELECT Notes.ID, Notes.Item_Title FROM Notes WHERE (((Notes.ID)=" & Val(PID_Note_ID) & "));"
0153 Set rs_PID = CurrentDb.OpenRecordset(strQuery)
0154 rs_PID.MoveFirst
0155 strDate = strDate & " (PID Note: [" & rs_PID.Fields(1) & "]++" & PID_Note_ID & "++)"
0156 Set rs_PID = Nothing
0157 End If
0158 strDate = strDate & " (WebRef=" & rs.Fields(0) & ", Unread, Priority=" & Priority & ")"
0159 If Aeon_Subtitle <> "" Then
0160 strDate = strDate & "<br>&rarr; " & Aeon_Subtitle
0161 End If
0162 End If
0163 End If
0164 Row_Text = Row_Text & ": " & strDate
0165 Note_Text_Local = Note_Text_Local & Row_Text
0166 rs.MoveNext
0167Loop
0168Note_Text_Local = Note_Text_Local & "|..|"
0169If Run_Type = 2 Then
0170 Note_Text_Local = Note_Text_Local & "|AA|"
0171End If
0172Note_Text = Note_Text_Local
0173Functor_18 = "Yes"
0174Set rs = Nothing
0175End Function

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


Source Code of: Page_Hits_Import_Control
Procedure Type: Public Sub
Module: Spider
Lines of Code: 175
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Page_Hits_Import_Control()
0002Dim fso As FileSystemObject
0003Dim fsoTextFile As FileSystemObject
0004Dim tsTextFileIn As TextStream
0005Dim rst As Recordset
0006Dim rst2 As Recordset
0007Dim DirectoryName As String
0008Dim Files_Processed As Integer
0009Dim MainFolder
0010Dim FileCollection
0011Dim File
0012Dim File_Name As String
0013Dim strLine As String
0014Dim InFile As String
0015Dim Rows_Read As Long
0016Dim Rows_Read_Total As Long
0017Dim iYear As Integer
0018Dim iMonth As Integer
0019Dim Bots As Boolean
0020Dim i As Integer
0021Dim j As Integer
0022Dim iHits As Long
0023Dim iBytes As Long
0024Dim strPage As String
0025Dim iFiles As Long
0026Dim iVisits As Long
0027Dim strQuery As String
0028Dim Updated As Boolean
0029Set fso = CreateObject("Scripting.FileSystemObject")
0030Set fsoTextFile = New FileSystemObject
0031DirectoryName = "C:\Theo's Files\Websites\Visitor_Stats\"
0032Set MainFolder = fso.GetFolder(DirectoryName)
0033Set FileCollection = MainFolder.Files
0034Files_Processed = 0
0035For Each File In FileCollection
0036 File_Name = File.Name
0037 If Left(File_Name, 9) = "Webalizer" Then
0038 InFile = DirectoryName & File_Name
0039 Set tsTextFileIn = fso.OpenTextFile(InFile, 1, False, 0) 'Open the file
0040 If InStr(File_Name, "Bots") > 0 Then
0041 Bots = True
0042 iYear = 2000 + Mid(File_Name, 16, 2)
0043 iMonth = Mid(File_Name, 18, 2)
0044 strQuery = "DELETE Hits_Bots.* FROM Hits_Bots WHERE Hits_Bots.[Year]=" & iYear & " AND Hits_Bots.[Month]=" & iMonth & ";"
0045 DoCmd.RunSQL (strQuery)
0046 Set rst = CurrentDb.OpenRecordset("SELECT Hits_Bots.* FROM Hits_Bots WHERE Hits_Bots.[Year]=" & iYear & " AND Hits_Bots.[Month]=" & iMonth & ";")
0047 Debug.Print Now(); "- "; File_Name
0048 Files_Processed = Files_Processed + 1
0049 Else
0050 Bots = False
0051 If InStr(File_Name, "Search") > 0 Then
0052 Debug.Print Now(); "- "; File_Name; " - File Ignored"
0053 Else
0054 iYear = 2000 + Mid(File_Name, 11, 2)
0055 iMonth = Mid(File_Name, 13, 2)
0056 strQuery = "DELETE Hits_Pages.* FROM Hits_Pages WHERE Hits_Pages.[Year]=" & iYear & " AND Hits_Pages.[Month]=" & iMonth & ";"
0057 DoCmd.RunSQL (strQuery)
0058 Set rst = CurrentDb.OpenRecordset("SELECT Hits_Pages.* FROM Hits_Pages WHERE Hits_Pages.[Year]=" & iYear & " AND Hits_Pages.[Month]=" & iMonth & ";")
0059 Debug.Print Now(); "- "; File_Name
0060 Files_Processed = Files_Processed + 1
0061 End If
0062 End If
0063 If InStr(File_Name, "Search") > 0 Then
0064 Else
0065 strLine = tsTextFileIn.ReadLine
0066 Rows_Read_Total = 1
0067 Rows_Read = 1
0068 Do Until tsTextFileIn.AtEndOfStream
0069 Rows_Read_Total = Rows_Read_Total + 1
0070 Rows_Read = Rows_Read + 1
0071 If Rows_Read > 10000 Then
0072 Rows_Read = 0
0073 Debug.Print Now(); "- Total Rows Read ="; Rows_Read_Total
0074 End If
0075 If IsNumeric(Left(strLine, 1)) Then
0076 i = 1
0077 j = 2
0078 Do Until Not IsNumeric(Mid(strLine, j, 1))
0079 j = j + 1
0080 Loop
0081 iHits = Mid(strLine, i, j - i)
0082 If Bots = True Then
0083 i = InStr(j, strLine, "%")
0084 j = i + 1
0085 Do Until IsNumeric(Mid(strLine, j, 1))
0086 j = j + 1
0087 Loop
0088 i = j
0089 Do Until Not IsNumeric(Mid(strLine, j, 1))
0090 j = j + 1
0091 Loop
0092 iFiles = Mid(strLine, i, j - i)
0093 End If
0094 i = InStr(j, strLine, "%")
0095 j = i + 1
0096 Do Until IsNumeric(Mid(strLine, j, 1))
0097 j = j + 1
0098 Loop
0099 i = j
0100 Do Until Not IsNumeric(Mid(strLine, j, 1))
0101 j = j + 1
0102 Loop
0103 iBytes = Mid(strLine, i, j - i)
0104 If Bots = True Then
0105 i = InStr(j, strLine, "%")
0106 j = i + 1
0107 Do Until IsNumeric(Mid(strLine, j, 1))
0108 j = j + 1
0109 Loop
0110 i = j
0111 Do Until Not IsNumeric(Mid(strLine, j, 1))
0112 j = j + 1
0113 Loop
0114 iVisits = Mid(strLine, i, j - i)
0115 End If
0116 If Bots = True Then
0117 i = InStr(j, strLine, "%")
0118 i = i + 1
0119 Else
0120 i = InStr(j, strLine, "/")
0121 End If
0122 strPage = Trim(Mid(strLine, i))
0123 strPage = Replace(strPage, Chr$(10), "")
0124 strPage = Replace(strPage, Chr$(13), "")
0125 'Check for case issues
0126 Updated = False
0127 If Bots = False Then
0128 Set rst2 = CurrentDb.OpenRecordset("SELECT Hits_Pages.* FROM Hits_Pages WHERE Hits_Pages.[Year]=" & iYear & " AND Hits_Pages.[Month]=" & iMonth & " AND Hits_Pages.URL=""" & strPage & """;")
0129 If Not rst2.EOF Then
0130 rst2.MoveFirst
0131 rst2.Edit
0132 rst2.Fields(3) = rst2.Fields(3) + iHits
0133 rst2.Fields(4) = rst2.Fields(4) + iBytes
0134 rst2.Update
0135 Debug.Print Now(); "- Duplicate: Updated"; strPage
0136 Updated = True
0137 End If
0138 Set rst2 = Nothing
0139 End If
0140 'Add to database
0141 If Updated = False Then
0142 rst.AddNew
0143 rst.Fields(0) = iYear
0144 rst.Fields(1) = iMonth
0145 rst.Fields(2) = strPage
0146 rst.Fields(3) = iHits
0147 rst.Fields(4) = iBytes
0148 If Bots = True Then
0149 rst.Fields(5) = iFiles
0150 rst.Fields(6) = iVisits
0151 End If
0152 rst.Update
0153 End If
0154 End If
0155 strLine = tsTextFileIn.ReadLine
0156 Loop
0157 Debug.Print Now(); "- Total Rows Read ="; Rows_Read_Total
0158 End If
0159 End If
0160 Set rst = Nothing
0161Next File
0162 Create_URL_Key1
0163 Create_URL_Key2
0164 DoCmd.OpenQuery ("Hits_Bots_By_URL_Key_Zap")
0165 DoCmd.OpenQuery ("Hits_Bots_By_URL_Key_Gen")
0166 DoCmd.OpenQuery ("Hits_Bots_Total_Zap")
0167 DoCmd.OpenQuery ("Hits_Bots_Total_Gen")
0168 DoCmd.OpenQuery ("Hits_Pages_Total_Zap")
0169 DoCmd.OpenQuery ("Hits_Pages_Total_Gen")
0170Set fso = Nothing
0171Set FileCollection = Nothing
0172Set fsoTextFile = Nothing
0173Set MainFolder = Nothing
0174Debug.Print Now(); "- Files Processed ="; Files_Processed
0175End Sub

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


Source Code of: Page_Hits_Page_Gen
Procedure Type: Public Sub
Module: Spider
Lines of Code: 154
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Page_Hits_Page_Gen(Report_ID)
0002Dim strOutputFolder As String
0003Dim strOutputFile As String
0004Dim strLine As String
0005Dim rsTableControl2 As Recordset
0006Dim i As Integer
0007Dim j As Integer
0008Dim FileName As String
0009Dim ifields As Integer
0010Dim strControlQuery As String
0011Dim rsFooterControl As Recordset
0012Dim x As String
0013Dim Link As String
0014Dim Link_Narr As String
0015Dim strLink_Narr As String
0016Dim strReport_Query As String
0017strOutputFolder = TheoWebsiteRoot & "\Test\"
0018Set fsoTextFile2 = New FileSystemObject
0019Select Case Report_ID
0020 Case 1
0021 strReport_Query = "Hits_Bots_Total_Crosstab_Descending"
0022 Case 2
0023 strReport_Query = "Hits_Pages_Total_Crosstab_Descending"
0024 Case Else
0025 MsgBox "Invalid request"
0026 Stop
0027 Exit Sub
0028End Select
0029Set rsTableControl2 = CurrentDb.OpenRecordset(strReport_Query)
0030FileName = strReport_Query & ".htm"
0031strOutputFile = strOutputFolder & FileName
0032Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFile, True, True)
0033strLine = "<!DOCTYPE html><HTML lang=""en"">"
0034tsTextFile.WriteLine strLine
0035strLine = "<HEAD><meta charset=""utf-8"">"
0036tsTextFile.WriteLine strLine
0037strLine = "<TITLE>Theo Todman's Consolidated Site-Hits Test Webpage</TITLE>"
0038tsTextFile.WriteLine strLine
0039strLine = "<link href=""../TheosStyle.css"" rel=""stylesheet"" type=""text/css""><link rel=""shortcut icon"" href=""../TT_ICO.png"" /></HEAD><BODY>"
0040tsTextFile.WriteLine strLine
0041strLine = "<H1>Theo Todman's Consolidated Site-Hits Test Webpage</H1><CENTER>"
0042tsTextFile.WriteLine strLine
0043Select Case Report_ID
0044 Case 1
0045 strLine = "<p>The table below lists the URLs that have accessed my Website more than 100 times since April 2018. The vast majority of these are robots. My estimate is that - apart from the home page and the css file which get hammered - robots hit each page about 5 times each a month. For the pages that have been hit more than 100 times over the same period, <a href=""Hits_Pages_Total_Crosstab_Descending.htm"">follow this link</a>. All this is still under development. </p>"
0046 Case 2
0047 strLine = "<p>The table of links below lists the pages on my Website that have been accessed more than 100 times since April 2018. The vast majority of these hits are by robots. For a similar page listing the major URLs accessing my site, <a href=""Hits_Bots_Total_Crosstab_Descending.htm"">follow this link</a>. My estimate is that - apart from the home page and the css file which get hammered - robots hit each page about 5 times each a month, so those on this page have most likely been hit by humans. All this is still under development. </p>"
0048End Select
0049strLine = strLine & "<p>These statistics were generated by <a href=""https://webalizer.net/"">Webalizer</a>, supplied by my ISP.</p>"
0050tsTextFile.WriteLine strLine
0051Select Case Report_ID
0052 Case 1
0053 strLine = "<H2>List of suspected Robot URLs</H2>"
0054 Case 2
0055 strLine = "<H2>List of Pages accessed, in descending order</H2>"
0056End Select
0057tsTextFile.WriteLine strLine
0058'Headings
0059If Not rsTableControl2.EOF Then
0060 ifields = rsTableControl2.Fields.Count
0061 i = 300 + (ifields - 1) * 50
0062 rsTableControl2.MoveFirst
0063 strLine = "<TABLE class = ""Bridge"" WIDTH=" & i & ">"
0064 tsTextFile.WriteLine strLine
0065 j = 0
0066 strLine = "<TR>"
0067 Do While j < ifields
0068 strLine = strLine & "<TH>" & rsTableControl2.Fields(j).Name & "</TH>"
0069 j = j + 1
0070 Loop
0071End If
0072strLine = strLine & "</TR>"
0073tsTextFile.WriteLine strLine
0074'Rows
0075Do While Not rsTableControl2.EOF
0076 strLine = "<TR>"
0077 j = 0
0078 Do While j < ifields
0079 x = rsTableControl2.Fields(j) & ""
0080 Select Case j
0081 Case 0
0082 If Report_ID = 2 Then
0083 Link_Narr = rsTableControl2.Fields(j) & ""
0084 Link = Link_Narr
0085 If Len(Link_Narr) = 1 Then
0086 'Proxy for root directory
0087 Link_Narr = "index.htm"
0088 Else
0089 Link_Narr = Mid(Link_Narr, 2)
0090 End If
0091 'Add Object name, if possible ...
0092 strLink_Narr = Link_Narr_Gen(Link)
0093 If strLink_Narr <> "" Then
0094 Link_Narr = strLink_Narr
0095 End If
0096 If Len(Link_Narr) > 50 Then
0097 Link_Narr = Left(Link_Narr, 40) & " ..."
0098 End If
0099 If Len(Link) = 1 Then
0100 x = "<a href=""../index.htm"">" & Link_Narr & "</a>"
0101 Else
0102 'Sundry fudges to avoid broken links ...
0103 If Right(Link, 1) = "/" Then
0104 Link = Link & "index.htm"
0105 End If
0106 If Link_Narr = "Descartes - Mind" Then
0107 Link = "Descartes - Mind&Body.pdf"
0108 End If
0109 If Link_Narr = "cgi-bin/search.php" Then
0110 x = Link_Narr
0111 Else
0112 x = "<a href="".." & Link & """>" & Link_Narr & "</a>"
0113 End If
0114 End If
0115 End If
0116 End Select
0117 strLine = strLine & "<TD>" & x & "</TD>"
0118 j = j + 1
0119 Loop
0120 strLine = strLine & "</TR>"
0121 tsTextFile.WriteLine strLine
0122 'Remove the (very long) tail
0123 If Report_ID = 1 Then
0124 j = 1
0125 Else
0126 j = 2
0127 End If
0128 If rsTableControl2.Fields(j) < 100 Then
0129 DoEvents
0130 rsTableControl2.MoveLast
0131 DoEvents
0132 rsTableControl2.MoveNext
0133 Else
0134 rsTableControl2.MoveNext
0135 End If
0136Loop
0137'Footer
0138strLine = "</TABLE><BR>"
0139tsTextFile.WriteLine strLine
0140'Page Footer
0141strLine = ""
0142strControlTable = "WebLinkCheck_Ctrl"
0143 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;"
0144Set rsFooterControl = CurrentDb.OpenRecordset(strControlQuery)
0145rsFooterControl.MoveFirst
0146Do While Not rsFooterControl.EOF
0147 strLine = strLine & rsFooterControl.Fields(0)
0148 OK = Replace_Timestamp(strLine)
0149 rsFooterControl.MoveNext
0150Loop
0151tsTextFile.WriteLine strLine
0152 OK = CopyToTransfer(strOutputFolder, FileName)
0153Set tsTextFile = Nothing
0154End Sub

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


Source Code of: WebpageGenAuthorsSummary
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 43
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenAuthorsSummary()
0002Dim strQuery As String
0003'Creat Authors_Summary_Temp
0004 strQuery = "DELETE * FROM Authors_Summary_Temp;"
0005DoCmd.RunSQL (strQuery)
0006 DoCmd.OpenQuery ("Authors_Summary_Temp_Gen")
0007 DoCmd.OpenQuery ("Author_Letters_Save")
0008 DoCmd.OpenQuery ("Author_Letters_All")
0009 DoCmd.OpenQuery ("Authors_List_Letter_Table_Zap")
0010 DoCmd.OpenQuery ("Authors_List_Letter_Table_GEN")
0011 DoCmd.OpenQuery ("Authors_List_Letter_Table_Add")
0012 DoCmd.OpenQuery ("Author_Letters_Revert")
0013 strQuery = "DELETE * FROM Authors_Summary_Temp_Count;"
0014DoCmd.RunSQL (strQuery)
0015 DoCmd.OpenQuery ("Authors_Summary_Temp_Count_Gen_Citations")
0016 DoCmd.OpenQuery ("Authors_Summary_Temp_Updt_Count_Citations")
0017 strQuery = "DELETE * FROM Authors_Summary_Temp_Count;"
0018DoCmd.RunSQL (strQuery)
0019 DoCmd.OpenQuery ("Authors_Summary_Temp_Count_Gen_Books")
0020 DoCmd.OpenQuery ("Authors_Summary_Temp_Updt_Count_Books")
0021 strQuery = "DELETE * FROM Authors_Summary_Temp_Count;"
0022DoCmd.RunSQL (strQuery)
0023 DoCmd.OpenQuery ("Authors_Summary_Temp_Count_Gen_Papers")
0024 DoCmd.OpenQuery ("Authors_Summary_Temp_Updt_Count_Papers")
0025 DoCmd.OpenQuery ("Authors_Summary_Temp_Surname_1")
0026 DoCmd.OpenQuery ("Authors_Summary_Temp_Surname_2")
0027 DoCmd.OpenQuery ("Authors_Summary_Temp_Surname_3")
0028 strQuery = "DELETE * FROM Author_Surnames;"
0029DoCmd.RunSQL (strQuery)
0030 DoCmd.OpenQuery ("Author_Surnames_Gen")
0031 DoCmd.OpenQuery ("Authors_Summary_Temp_Surname_CountUpdt")
0032 DoCmd.OpenQuery ("Authors_Counts_Updt")
0033 strControlTable = "Authors_Summary"
0034 strOutputFileShort = "Authors_Summary"
0035strOutputFolder = TheoWebsiteRoot & "\"
0036strOutputFile = strOutputFolder & strOutputFileShort
0037 strDataQuery = "Authors_Summary"
0038strSplitTable = "Yes"
0039strControlBreakType = "Initial"
0040strControlBreakType2 = ""
0041Main_Header = "Yes"
0042 CreatePapersWebTable
0043End Sub

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


© Theo Todman, June 2007 - April 2026. 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