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 26 (7 items)

cmdTranslateNoteRefs_ClickFunctor_07Functor_08Functor_09
Auto_Translate_Reference_NotesLogStatsWebpageGenDud_Abstracts_Papers.

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

Go to top of page



Source Code of: Auto_Translate_Reference_Notes
Procedure Type: Public Sub
Module: Testing
Lines of Code: 248
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Auto_Translate_Reference_Notes()
0002'This Sub translates and "fixes" "++++" & "+NN+" references in Notes & other Objects. This is to improve performance by obviating the need for look-ups.
0003Dim rsKeyWords As Recordset
0004Dim rsKeyWords_Update As Recordset
0005Dim rsObject As Recordset
0006Dim rsNotes_To_Regen As Recordset
0007Dim rsAuto_Translate_Reference_Notes_Actions As Recordset
0008Dim strQuery As String
0009Dim iUpdates As Long
0010Dim iUpdates_Total As Long
0011Dim Duration As Single
0012Dim RunStartTime As Date
0013Dim strKeyWord As String
0014Dim Object_Type As String
0015Dim iObject_ID As Integer
0016Dim strObject_Text As String
0017Dim i As Long
0018Dim k As Long
0019Dim iNote As Integer
0020Dim Link_OK As Boolean
0021Dim The_Word As String
0022Dim The_Word_OK As Boolean
0023Dim Update_Object As Boolean
0024Dim Updating_Run_Notes As Boolean
0025Dim Update_Notes_Archive As Boolean
0026Dim iCounter As Integer
0027Dim In_Documentation As Boolean
0028iUpdates_Total = 0
0029Updating_Run_Notes = False
0030RunStartTime = Now()
0031'Clear the Notes_To_Regen table ...
0032 strQuery = "DELETE * FROM Notes_To_Regen;"
0033DoCmd.RunSQL (strQuery)
0034'Ready the Log
0035 strQuery = "SELECT Auto_Translate_Reference_Notes_Actions.Timestamp_Logged, Auto_Translate_Reference_Notes_Actions.Object_Type, Auto_Translate_Reference_Notes_Actions.Object_ID, Auto_Translate_Reference_Notes_Actions.Timestamp, Auto_Translate_Reference_Notes_Actions.Tag_Found, Auto_Translate_Reference_Notes_Actions.Key_Word_Detected, Auto_Translate_Reference_Notes_Actions.Note_ID, Auto_Translate_Reference_Notes_Actions.Key_Word_Offset, Auto_Translate_Reference_Notes_Actions.Action_Taken FROM Auto_Translate_Reference_Notes_Actions WHERE (((Auto_Translate_Reference_Notes_Actions.Timestamp_Logged)=0));"
0036Set rsAuto_Translate_Reference_Notes_Actions = CurrentDb.OpenRecordset(strQuery)
0037'Read & process the objects - Notes, Paper Abstracts, Comments, Book Abstracts, Comments, Archived Notes ...
0038For iCounter = 1 To 14
0039 iUpdates = 0
0040 Select Case iCounter
0041 Case 1
0042 strQuery = "SELECT Notes.ID, Notes.Item_Text, Notes.Status FROM Notes WHERE (((Notes.Item_Text) Like ""*++++*"")) ORDER BY Notes.ID;"
0043 strKeyWord = "++++"
0044 Object_Type = "Notes"
0045 Case 2
0046 strQuery = "SELECT Notes.ID, Notes.Item_Text, Notes.Status FROM Notes WHERE (((Notes.Item_Text) Like ""*+NN+*"")) ORDER BY Notes.ID;"
0047 strKeyWord = "+NN+"
0048 Object_Type = "Notes"
0049 Case 3
0050 strQuery = "SELECT Authors.Author_ID, Authors.Author_Narrative FROM Authors WHERE (((Authors.Author_Narrative) Like ""*++++*"")) ORDER BY Authors.Author_ID;"
0051 strKeyWord = "++++"
0052 Object_Type = "Authors"
0053 Case 4
0054 strQuery = "SELECT Authors.Author_ID, Authors.Author_Narrative FROM Authors WHERE (((Authors.Author_Narrative) Like ""*+NN+*"")) ORDER BY Authors.Author_ID;"
0055 strKeyWord = "+NN+"
0056 Object_Type = "Authors"
0057 Case 5
0058 strQuery = "SELECT Papers.ID, Papers.Abstract FROM Papers WHERE (((Papers.Abstract) Like ""*++++*"")) ORDER BY Papers.ID;"
0059 strKeyWord = "++++"
0060 Object_Type = "Paper Abstracts"
0061 Case 6
0062 strQuery = "SELECT Papers.ID, Papers.Abstract FROM Papers WHERE (((Papers.Abstract) Like ""*+NN+*"")) ORDER BY Papers.ID;"
0063 strKeyWord = "+NN+"
0064 Object_Type = "Paper Abstracts"
0065 Case 7
0066 strQuery = "SELECT Papers.ID, Papers.Comments FROM Papers WHERE (((Papers.Comments) Like ""*++++*"")) ORDER BY Papers.ID;"
0067 strKeyWord = "++++"
0068 Object_Type = "Paper Comments"
0069 Case 8
0070 strQuery = "SELECT Papers.ID, Papers.Comments FROM Papers WHERE (((Papers.Comments) Like ""*+NN+*"")) ORDER BY Papers.ID;"
0071 strKeyWord = "+NN+"
0072 Object_Type = "Paper Comments"
0073 Case 9
0074 strQuery = "SELECT Books.ID1, Books.Abstract FROM Books WHERE (((Books.Abstract) Like ""*++++*"")) ORDER BY Books.ID1;"
0075 strKeyWord = "++++"
0076 Object_Type = "Book Abstracts"
0077 Case 10
0078 strQuery = "SELECT Books.ID1, Books.Abstract FROM Books WHERE (((Books.Abstract) Like ""*+NN+*"")) ORDER BY Books.ID1;"
0079 strKeyWord = "+NN+"
0080 Object_Type = "Book Abstracts"
0081 Case 11
0082 strQuery = "SELECT Books.ID1, Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++++*"")) ORDER BY Books.ID1;"
0083 strKeyWord = "++++"
0084 Object_Type = "Book Comments"
0085 Case 12
0086 strQuery = "SELECT Books.ID1, Books.Comments FROM Books WHERE (((Books.Comments) Like ""*+NN+*"")) ORDER BY Books.ID1;"
0087 strKeyWord = "+NN+"
0088 Object_Type = "Book Comments"
0089 Case 13
0090 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text, Notes_Archive.Timestamp FROM Notes_Archive WHERE (((Notes_Archive.Item_Text) Like ""*++++*"")) ORDER BY Notes_Archive.ID;"
0091 strKeyWord = "++++"
0092 Object_Type = "Notes_Archive"
0093 Case 14
0094 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text, Notes_Archive.Timestamp FROM Notes_Archive WHERE (((Notes_Archive.Item_Text) Like ""*+NN+*"")) ORDER BY Notes_Archive.ID;"
0095 strKeyWord = "+NN+"
0096 Object_Type = "Notes_Archive"
0097 End Select
0098 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0099 If Not rsObject.EOF Then
0100 rsObject.MoveFirst
0101 Do Until rsObject.EOF
0102 iObject_ID = rsObject.Fields(0)
0103 strObject_Text = rsObject.Fields(1)
0104 Update_Object = False
0105 If iCounter >= 1 And iCounter <= 2 Then 'Notes only!
0106 Update_Notes_Archive = False
0107 'Check the Archived Note
0108 If rsObject.Fields(2) = "Temp" Then
0109 'Don't bother for Temp Notes
0110 Else
0111 'Find the latest Archive Note
0112 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text, Notes_Archive.Timestamp FROM Notes_Archive WHERE (((Notes_Archive.ID) = " & iObject_ID & ")) ORDER BY Notes_Archive.Timestamp DESC;"
0113 Set rsKeyWords_Update = CurrentDb.OpenRecordset(strQuery)
0114 If Not rsKeyWords_Update.EOF Then
0115 If strObject_Text = rsKeyWords_Update.Fields(1) Then
0116 Update_Notes_Archive = True
0117 End If
0118 End If
0119 End If
0120 End If
0121 'Find the next strKeyWord
0122 i = 1
0123 Link_OK = False
0124 Do Until i = 0
0125 i = InStr(i, strObject_Text, strKeyWord)
0126 If i > 0 Then
0127 Link_OK = True
0128 Else
0129 Link_OK = False
0130 End If
0131 If Link_OK = True Then
0132 k = FindWord(strObject_Text, i, "]") 'Find Start of word
0133 If k > 1 Then
0134 The_Word_OK = True
0135 The_Word = Mid(strObject_Text, k, i - k)
0136 'Check no Bracket at start ...
0137 If Mid(strObject_Text, i - 1, 1) = "]" Then
0138 The_Word = Mid(The_Word, 2, Len(The_Word) - 2)
0139 End If
0140 'Translate ...
0141 strQuery = "SELECT Note_Alternates.ID FROM Note_Alternates WHERE (((Note_Alternates.Item_Alt_Title)=""" & The_Word & """));"
0142 Set rsKeyWords = CurrentDb.OpenRecordset(strQuery)
0143 If rsKeyWords.EOF Then
0144 Debug.Print Now() & " - "; "Incorrect Keyword: "; Object_Type; iObject_ID; The_Word
0145 iNote = 0
0146 Else
0147 rsKeyWords.MoveFirst
0148 iNote = rsKeyWords.Fields(0)
0149 strObject_Text = Left(strObject_Text, i + 1) & iNote & Mid(strObject_Text, i + 2)
0150 Update_Object = True
0151 End If
0152 The_Word = Trim(The_Word)
0153 In_Documentation = False
0154 If The_Word = "" Then 'Check for documentation ... ie. "+NN+" and the like ...
0155 If Mid(strObject_Text, i - 1, 1) <> " " And Mid(strObject_Text, k + 4, 1) <> " " Then
0156 In_Documentation = True
0157 End If
0158 End If
0159 If In_Documentation = False Then
0160 'Log
0161 rsAuto_Translate_Reference_Notes_Actions.AddNew
0162 rsAuto_Translate_Reference_Notes_Actions.Fields(0) = Now()
0163 rsAuto_Translate_Reference_Notes_Actions.Fields(1) = Object_Type
0164 rsAuto_Translate_Reference_Notes_Actions.Fields(2) = iObject_ID
0165 If iCounter >= 13 Then
0166 rsAuto_Translate_Reference_Notes_Actions.Fields(3) = rsObject.Fields(2)
0167 End If
0168 rsAuto_Translate_Reference_Notes_Actions.Fields(4) = strKeyWord
0169 rsAuto_Translate_Reference_Notes_Actions.Fields(5) = The_Word
0170 rsAuto_Translate_Reference_Notes_Actions.Fields(6) = iNote
0171 rsAuto_Translate_Reference_Notes_Actions.Fields(7) = k
0172 If iNote > 0 Then
0173 rsAuto_Translate_Reference_Notes_Actions.Fields(8) = "Object updated OK"
0174 End If
0175 rsAuto_Translate_Reference_Notes_Actions.Update
0176 End If
0177 End If
0178 If Update_Object = True Then
0179 'Write out to Notes_To_Regen if it doesn't already exist
0180 If iCounter >= 1 And iCounter <= 2 Then 'Notes only!
0181 Updating_Run_Notes = True
0182 strQuery = "SELECT * FROM Notes_To_Regen WHERE Note_ID=" & iObject_ID & ";"
0183 Set rsNotes_To_Regen = CurrentDb.OpenRecordset(strQuery)
0184 If rsNotes_To_Regen.EOF Then
0185 rsNotes_To_Regen.AddNew
0186 rsNotes_To_Regen.Fields(0) = iObject_ID
0187 rsNotes_To_Regen.Fields(1) = Now()
0188 rsNotes_To_Regen.Update
0189 End If
0190 End If
0191 End If
0192 i = i + 1
0193 End If
0194 Loop
0195 If Update_Object = True Then
0196 iUpdates = iUpdates + 1
0197 'Update the Object
0198 rsObject.Edit
0199 rsObject.Fields(1) = strObject_Text
0200 rsObject.Update
0201 If iCounter >= 1 And iCounter <= 2 Then 'Notes only!
0202 If Update_Notes_Archive = True Then
0203 rsKeyWords_Update.Edit
0204 rsKeyWords_Update.Fields(1) = strObject_Text
0205 rsKeyWords_Update.Update
0206 iUpdates_Total = iUpdates_Total + 1
0207 End If
0208 End If
0209 End If
0210 rsObject.MoveNext
0211 Loop
0212 End If
0213 Debug.Print Now() & " - "; Object_Type; " "; strKeyWord; iUpdates; "Updates"
0214 iUpdates_Total = iUpdates_Total + iUpdates
0215Next iCounter
0216'Output the Notes Pages
0217 strQuery = "SELECT * FROM Notes_To_Regen;"
0218Set rsNotes_To_Regen = CurrentDb.OpenRecordset(strQuery)
0219If rsNotes_To_Regen.EOF Then
0220 i = 0
0221Else
0222 rsNotes_To_Regen.MoveLast
0223 i = rsNotes_To_Regen.RecordCount
0224End If
0225If i > 0 Then
0226 If MsgBox("Output " & i & " updated Notes?", vbYesNo) = vbYes Then
0227 Archive_Notes_Now = "No"
0228 Regenerate_the_Links = "No"
0229 Regen_Notes_Only = "Yes"
0230 CreateNotesWebPages
0231 End If
0232End If
0233'Tidy Up
0234Set rsKeyWords = Nothing
0235Set rsObject = Nothing
0236Set rsNotes_To_Regen = Nothing
0237Set rsKeyWords_Update = Nothing
0238Set rsAuto_Translate_Reference_Notes_Actions = Nothing
0239 DoCmd.OpenQuery ("Auto_Translate_Reference_Notes_Actions_List")
0240Debug.Print Now() & " - "; " Total"; iUpdates_Total; "Updates"
0241Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0242If Duration < 1 Then
0243 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0244 MsgBox Now() & " - Automatic Note Linkage Translations Completed in " & Duration & " seconds. " & iUpdates_Total & " changes made.", vbOKOnly, "Automatic Note Linkages"
0245Else
0246 MsgBox Now() & " - Automatic Note Linkages Translations Completed in " & Duration & " minutes. " & iUpdates_Total & " changes made.", vbOKOnly, "Automatic Note Linkages"
0247End If
0248End Sub

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


Source Code of: cmdTranslateNoteRefs_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 5

Line-No. / Ref.Code Line
0001Private Sub cmdTranslateNoteRefs_Click()
0002If MsgBox("Do you want to translate and fix ""++++"" & ""+NN+"" references in Notes & other Objects?", vbYesNo) = vbYes Then
0003 Auto_Translate_Reference_Notes
0004End If
0005End Sub

Procedures Called By This Procedure (cmdTranslateNoteRefs_Click) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Functor_07
Procedure Type: Public Function
Module: Functors
Lines of Code: 30
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_07(Note_ID, Note_Title, Note_Text)
0002'Insert Stats into Note 1247 (Website Generator Documentation - Web Links)
0003Dim rs As Recordset
0004Dim Note_Text_Local As String
0005Dim i As Double
0006Dim Raw_Links_Rows As String
0007Dim Link_Type_Web As String
0008Dim Unique_External_Links As String
0009 Set rs = CurrentDb.OpenRecordset("SELECT Count(Raw_Links.Directory) AS CountOfDirectory FROM Raw_Links;")
0010rs.MoveFirst
0011i = rs.Fields(0)
0012Raw_Links_Rows = Round(i / 1000000, 2)
0013Set rs = Nothing
0014 Set rs = CurrentDb.OpenRecordset("SELECT Count(Raw_Links.Directory) AS CountOfDirectory FROM Raw_Links WHERE (((Raw_Links.Link_Type)=""Web""));")
0015rs.MoveFirst
0016i = rs.Fields(0)
0017Link_Type_Web = Round(i / 1000, 1)
0018Set rs = Nothing
0019 Set rs = CurrentDb.OpenRecordset("SELECT Count(Webrefs_Table.ID) AS CountOfID FROM Webrefs_Table WHERE (((Webrefs_Table.[Defunct?])=No));")
0020rs.MoveFirst
0021i = rs.Fields(0)
0022Unique_External_Links = Round(i / 1000, 1)
0023Set rs = Nothing
0024Note_Text_Local = "There are - as of " & Now() & " - about " & Raw_Links_Rows
0025Note_Text_Local = Note_Text_Local & " million rows in the +TRaw_LinksT+ table, but only around " & Link_Type_Web
0026Note_Text_Local = Note_Text_Local & "k are external links (of Link_Type = ""Web""), which is still rather a lot, though most are ""repeats""! "
0027Note_Text_Local = Note_Text_Local & "There are about " & Unique_External_Links & "k active unique external links."
0028Note_Text = Note_Text_Local
0029Functor_07 = "Yes"
0030End Function

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


Source Code of: Functor_08
Procedure Type: Public Function
Module: Functors
Lines of Code: 234
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_08(Note_ID, Note_Title, Note_Text)
0002'Insert Stats into Quarterly Reports
0003Dim rs As Recordset
0004Dim strQuery As String
0005Dim Note_Text_Local As String
0006Dim iStart_Reporting_Month As Integer
0007Dim iReporting_Year As Integer
0008Dim Qtr_Days As Single
0009Dim Qtr_Fraction_Gone As Single
0010Dim Hours_Left_Today As Single
0011Dim strQuarter_From As String
0012Dim strQuarter_To As String
0013Dim strQuarter_Long As String
0014Dim strQuarter_Short As String
0015Dim str_Period_Start As String
0016Dim QTDHrs As Single
0017Dim YTDHrs As Single
0018Dim QTDHrs_Total As Single
0019Dim YTDHrs_Total As Single
0020Dim QTD_Percent_Plan As Single
0021Dim YTD_Percent_Plan As Single
0022Dim QTD_Overall_Percent As Single
0023Dim QTD_Overall_Percent_Plan As Single
0024Dim YTD_Overall_Percent As Single
0025Dim YTD_Overall_Percent_Plan As Single
0026Dim QTDPlan As Single
0027Dim YTDPlan As Single
0028Dim QTDPlan_Overall As Single
0029Dim YTDPlan_Overall As Single
0030Dim YTDPlan_Footnote As String
0031Dim Current_Qtr As String
0032Dim strYear As String
0033Dim strQuarter As String
0034Dim Last_Year As Boolean
0035YTDPlan_Footnote = "++FNIf zero hours are planned, ""%age against plan"" is meaningless, and appears as zero. ++"
0036'Find the Report Year & Quarter
0037 OK = Find_Report_Period(Note_Title, strYear, strQuarter)
0038 Set rs = CurrentDb.OpenRecordset("SELECT * FROM Next_Reporting_Month;")
0039rs.MoveFirst
0040iStart_Reporting_Month = rs.Fields(1)
0041Current_Qtr = rs.Fields(8)
0042iReporting_Year = rs.Fields(5)
0043Qtr_Days = rs.Fields(11)
0044Hours_Left_Today = rs.Fields(12)
0045Qtr_Days = Qtr_Days - Hours_Left_Today / 7
0046Qtr_Fraction_Gone = rs.Fields(10) / rs.Fields(11)
0047'Check if running for the previous Quarter - ie. after the roll-over.
0048Last_Year = False
0049If Right(strQuarter, 1) <> Right(Current_Qtr, 1) Then
0050 'Report for the last quarter of last academic year
0051 Last_Year = True
0052 iStart_Reporting_Month = CInt(Right(strQuarter, 1))
0053 iStart_Reporting_Month = 1 + (iStart_Reporting_Month - 1) * 3
0054 Current_Qtr = Right(strYear, 2) & strQuarter
0055 iReporting_Year = CInt(strYear)
0056 If strQuarter <> "Q4" Then
0057 iReporting_Year = iReporting_Year - 1
0058 End If
0059 If strQuarter <> "Q3" Then
0060 Last_Year = False 'This used to say 'True' ...???!
0061 End If
0062 Qtr_Days = 365 / 4 'Dummy figure
0063 Hours_Left_Today = 0
0064 Qtr_Fraction_Gone = 1
0065End If
0066Select Case iStart_Reporting_Month
0067 Case 1
0068 strQuarter_Long = "January - March"
0069 strQuarter_Short = "Q1"
0070 strQuarter_From = iReporting_Year + 1 & "-01"
0071 strQuarter_To = iReporting_Year + 1 & "-03"
0072 Case 4
0073 strQuarter_Long = "April - June"
0074 strQuarter_Short = "Q2"
0075 strQuarter_From = iReporting_Year + 1 & "-04"
0076 strQuarter_To = iReporting_Year + 1 & "-06"
0077 Case 7
0078 strQuarter_Long = "July - September"
0079 strQuarter_Short = "Q3"
0080 strQuarter_From = iReporting_Year + 1 & "-07"
0081 strQuarter_To = iReporting_Year + 1 & "-09"
0082 Case 10
0083 strQuarter_Long = "October - December"
0084 strQuarter_Short = "Q4"
0085 strQuarter_From = iReporting_Year & "-10"
0086 strQuarter_To = iReporting_Year & "-12"
0087End Select
0088If iStart_Reporting_Month < 10 Then
0089 strQuarter_Long = strQuarter_Long & " " & iReporting_Year + 1
0090 strQuarter_Short = Right(iReporting_Year + 1, 2) & strQuarter_Short
0091Else
0092 strQuarter_Long = strQuarter_Long & " " & iReporting_Year
0093 strQuarter_Short = Right(iReporting_Year, 2) & strQuarter_Short
0094End If
0095str_Period_Start = "October " & iReporting_Year
0096Set rs = Nothing
0097If Last_Year = True Then
0098 strQuery = "SELECT Sum(Year_Crosstab_Old.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab_Old ON Projects.Project_Name = Year_Crosstab_Old.Group WHERE (((Year_Crosstab_Old.Period) >= """ & strQuarter_From & """ And (Year_Crosstab_Old.Period) <= """ & strQuarter_To & """)) GROUP BY Projects.Status_Note HAVING (((Projects.Status_Note)=" & Note_ID & "));"
0099Else
0100 strQuery = "SELECT Sum(Year_Crosstab.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab ON Projects.Project_Name = Year_Crosstab.Group WHERE (((Year_Crosstab.Period) >= """ & strQuarter_From & """ And (Year_Crosstab.Period) <= """ & strQuarter_To & """)) GROUP BY Projects.Status_Note HAVING (((Projects.Status_Note)=" & Note_ID & "));"
0101End If
0102Set rs = CurrentDb.OpenRecordset(strQuery)
0103If rs.EOF Then
0104 QTDHrs = 0
0105Else
0106 rs.MoveFirst
0107 QTDHrs = rs.Fields(0)
0108End If
0109Set rs = Nothing
0110If Last_Year = True Then
0111 strQuery = "SELECT Sum(Year_Crosstab_Old.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab_Old ON Projects.Project_Name = Year_Crosstab_Old.Group WHERE (((Year_Crosstab_Old.Period) >= """ & iReporting_Year & "-10" & """ And (Year_Crosstab_Old.Period) <= """ & strQuarter_To & """)) GROUP BY Projects.Status_Note HAVING (((Projects.Status_Note)=" & Note_ID & "));"
0112Else
0113 strQuery = "SELECT Sum(Year_Crosstab.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab ON Projects.Project_Name = Year_Crosstab.Group WHERE (((Year_Crosstab.Period) >= """ & iReporting_Year & "-10" & """ And (Year_Crosstab.Period) <= """ & strQuarter_To & """)) GROUP BY Projects.Status_Note HAVING (((Projects.Status_Note)=" & Note_ID & "));"
0114End If
0115Set rs = CurrentDb.OpenRecordset(strQuery)
0116If rs.EOF Then
0117 YTDHrs = 0
0118Else
0119 rs.MoveFirst
0120 YTDHrs = rs.Fields(0)
0121End If
0122Set rs = Nothing
0123If Last_Year = True Then
0124 strQuery = "SELECT Sum(Year_Crosstab_Old.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab_Old ON Projects.Project_Name = Year_Crosstab_Old.Group WHERE (((Year_Crosstab_Old.Period) >= """ & strQuarter_From & """ And (Year_Crosstab_Old.Period) <= """ & strQuarter_To & """));"
0125Else
0126 strQuery = "SELECT Sum(Year_Crosstab.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab ON Projects.Project_Name = Year_Crosstab.Group WHERE (((Year_Crosstab.Period) >= """ & strQuarter_From & """ And (Year_Crosstab.Period) <= """ & strQuarter_To & """));"
0127End If
0128Set rs = CurrentDb.OpenRecordset(strQuery)
0129rs.MoveFirst
0130QTDHrs_Total = Nz(rs.Fields(0))
0131Set rs = Nothing
0132If QTDHrs_Total = 0 Then
0133 QTDHrs_Total = 0.0001
0134End If
0135QTD_Overall_Percent = QTDHrs / QTDHrs_Total * 100
0136If Last_Year = True Then
0137 strQuery = "SELECT Sum(Year_Crosstab_Old.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab_Old ON Projects.Project_Name = Year_Crosstab_Old.Group WHERE (((Year_Crosstab_Old.Period) >= """ & iReporting_Year & "-10" & """ And (Year_Crosstab_Old.Period) <= """ & strQuarter_To & """));"
0138Else
0139 strQuery = "SELECT Sum(Year_Crosstab.Hours) AS SumOfHours FROM Projects INNER JOIN Year_Crosstab ON Projects.Project_Name = Year_Crosstab.Group WHERE (((Year_Crosstab.Period) >= """ & iReporting_Year & "-10" & """ And (Year_Crosstab.Period) <= """ & strQuarter_To & """));"
0140End If
0141Set rs = CurrentDb.OpenRecordset(strQuery)
0142rs.MoveFirst
0143YTDHrs_Total = Nz(rs.Fields(0))
0144Set rs = Nothing
0145If YTDHrs_Total = 0 Then
0146 YTDHrs_Total = 0.0001
0147End If
0148YTD_Overall_Percent = YTDHrs / YTDHrs_Total * 100
0149 strQuery = "SELECT Sum(Project_Plans.Weekly_Hours) AS SumOfWeekly_Hours FROM Projects INNER JOIN Project_Plans ON Projects.Project_Name = Project_Plans.Project WHERE (((Projects.Status_Note)=" & Note_ID & ") AND ((Project_Plans.Period)>=""" & strQuarter_From & """ And (Project_Plans.Period)<=""" & strQuarter_To & """));"
0150Set rs = CurrentDb.OpenRecordset(strQuery)
0151rs.MoveFirst
0152QTDPlan = Nz(rs.Fields(0))
0153QTDPlan = QTDPlan / 3 / 7 * Qtr_Days * Qtr_Fraction_Gone
0154Set rs = Nothing
0155If QTDPlan = 0 Then
0156 QTD_Percent_Plan = 0
0157Else
0158 QTD_Percent_Plan = QTDHrs / QTDPlan * 100
0159End If
0160 strQuery = "SELECT Sum(Project_Plans.Weekly_Hours) AS SumOfWeekly_Hours FROM Projects INNER JOIN Project_Plans ON Projects.Project_Name = Project_Plans.Project WHERE (((Projects.Status_Note)=" & Note_ID & ") AND ((Project_Plans.Period)>=""" & iReporting_Year & "-10" & """ And (Project_Plans.Period)<""" & strQuarter_From & """));"
0161Set rs = CurrentDb.OpenRecordset(strQuery)
0162rs.MoveFirst
0163YTDPlan = Nz(rs.Fields(0)) / 3 / 7 * 365 / 4
0164YTDPlan = YTDPlan + QTDPlan
0165Set rs = Nothing
0166If YTDPlan = 0 Then
0167 YTD_Percent_Plan = 0
0168Else
0169 YTD_Percent_Plan = YTDHrs / YTDPlan * 100
0170End If
0171 strQuery = "SELECT Sum(Project_Plans.Weekly_Hours) AS SumOfWeekly_Hours FROM Projects INNER JOIN Project_Plans ON Projects.Project_Name = Project_Plans.Project WHERE (((Project_Plans.Period)>=""" & strQuarter_From & """ And (Project_Plans.Period)<=""" & strQuarter_To & """));"
0172Set rs = CurrentDb.OpenRecordset(strQuery)
0173rs.MoveFirst
0174QTDPlan_Overall = rs.Fields(0)
0175QTDPlan_Overall = QTDPlan_Overall / 3 / 7 * Qtr_Days * Qtr_Fraction_Gone
0176Set rs = Nothing
0177QTD_Overall_Percent_Plan = QTDPlan / QTDPlan_Overall * 100
0178'strQuery = "SELECT Sum(Project_Plans.Weekly_Hours) AS SumOfWeekly_Hours FROM Projects INNER JOIN Project_Plans ON Projects.Project_Name = Project_Plans.Project WHERE (((Project_Plans.Period)>=""" & iReporting_Year & "-10" & """ And (Project_Plans.Period)<=""" & iReporting_Year & "-" & strQuarter_To & """));"
0179'The above query was incorrect, and may explain some of the muddles below ...
0180 strQuery = "SELECT Sum(Project_Plans.Weekly_Hours) AS SumOfWeekly_Hours FROM Projects INNER JOIN Project_Plans ON Projects.Project_Name = Project_Plans.Project WHERE (((Project_Plans.Period)>=""" & iReporting_Year & "-10" & """ And (Project_Plans.Period)<=""" & strQuarter_To & """));"
0181Set rs = CurrentDb.OpenRecordset(strQuery)
0182rs.MoveFirst
0183'***** THIS CODE NEEDS SORTING OUT - SERIES OF BODGES **************
0184'YTDPlan_Overall = rs.Fields(0) / 3 / 7 * 365 / 4 ' ... replaced for 2019_Q3 report
0185'YTDPlan_Overall = rs.Fields(0) / 3 / 7 * 365 ' ... replaced for 2019_Q4 report
0186'YTDPlan_Overall = YTDPlan_Overall + QTDPlan_Overall 'THIS WAS COMMENTED OUT prior to the 19Q2 report - why?
0187'Looks like it should have been commented out!! Removed for 19Q3 report
0188If Right(Current_Qtr, 2) = "Q4" Then
0189 'Force equality!
0190 YTDPlan_Overall = QTDPlan_Overall
0191 YTD_Overall_Percent_Plan = QTD_Overall_Percent_Plan
0192Else
0193 YTDPlan_Overall = rs.Fields(0) / 3 / 7 * 365 / 4
0194 'If Right(Current_Qtr, 2) = "Q1" Then 'Bodge put in 02/04/2020 ... sort it out when I have more time!
0195 ' YTDPlan_Overall = YTDPlan_Overall + QTDPlan_Overall
0196 'End If
0197 'Taken out on 01/04/2021! I had not "rolled over" this time
0198 YTD_Overall_Percent_Plan = YTDPlan / YTDPlan_Overall * 100
0199End If
0200Set rs = Nothing
0201If Note_ID = 512 Then
0202 Note_Text_Local = "|.|In " & strQuarter_Short
0203 Note_Text_Local = Note_Text_Local & " I spent across my various projects " & Round(QTDHrs_Total, 2)
0204 Note_Text_Local = Note_Text_Local & " hours (" & Round(YTDHrs_Total, 2)
0205 Note_Text_Local = Note_Text_Local & " hours YTD) – where by ""YTD"" - Year to Date - I mean the academic year commencing in " & str_Period_Start
0206 Note_Text_Local = Note_Text_Local & ". ""Actual versus plan"" was " & Round(QTDHrs_Total / QTDPlan_Overall * 100, 1)
0207 Note_Text_Local = Note_Text_Local & "%, (" & Round(YTDHrs_Total / YTDPlan_Overall * 100, 1)
0208 Note_Text_Local = Note_Text_Local & "% YTD)."
0209Else
0210 If QTDPlan = 0 Then
0211 Note_Text_Local = "<B><U>Summary of Progress during " & Right(iReporting_Year, 2) & "Q4" & " - " & Current_Qtr
0212 Note_Text_Local = Note_Text_Local & "</B></U>|99||1|I have spent " & Round(YTDHrs, 2)
0213 Note_Text_Local = Note_Text_Local & " hour" & IIf(Round(YTDHrs, 2) = 1, "", "s") & " YTD on this Project, or related work, where for ""YTD"" - Year to Date - I mean the (academic) year that commenced in " & str_Period_Start
0214 Note_Text_Local = Note_Text_Local & "). That's " & Round(YTD_Percent_Plan, 1)
0215 Note_Text_Local = Note_Text_Local & "% of the planned" & IIf(YTDPlan = 0, YTDPlan_Footnote, "") & " effort. Overall, " & Round(YTD_Overall_Percent, 1)
0216 Note_Text_Local = Note_Text_Local & "% of my Project effort YTD has been directed towards this project."
0217 Else
0218 Note_Text_Local = "<B><U>Summary of Progress during " & strQuarter_Long
0219 Note_Text_Local = Note_Text_Local & "</B></U>|99||1|I spent " & Round(QTDHrs, 2)
0220 Note_Text_Local = Note_Text_Local & " hour" & IIf(Round(QTDHrs, 2) = 1, "", "s") & " in " & strQuarter_Short
0221 Note_Text_Local = Note_Text_Local & " on this Project, or related work (" & Round(YTDHrs, 2)
0222 Note_Text_Local = Note_Text_Local & " hour" & IIf(Round(YTDHrs, 2) = 1, "", "s") & " YTD, where for ""YTD"" - Year to Date - I mean the (academic) year that commenced in " & str_Period_Start
0223 Note_Text_Local = Note_Text_Local & "). That's " & Round(QTD_Percent_Plan, 1)
0224 Note_Text_Local = Note_Text_Local & "% of the planned effort (" & Round(YTD_Percent_Plan, 1)
0225 Note_Text_Local = Note_Text_Local & "% YTD). Overall, " & Round(QTD_Overall_Percent, 1)
0226 Note_Text_Local = Note_Text_Local & "% of my Project effort in the Quarter was directed towards this project (making " & Round(YTD_Overall_Percent, 1)
0227 Note_Text_Local = Note_Text_Local & "% YTD) - as against " & Round(QTD_Overall_Percent_Plan, 1)
0228 Note_Text_Local = Note_Text_Local & "% planned (" & Round(YTD_Overall_Percent_Plan, 1)
0229 Note_Text_Local = Note_Text_Local & "% YTD)."
0230 End If
0231End If
0232Note_Text = Note_Text_Local
0233Functor_08 = "Yes"
0234End Function

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


Source Code of: Functor_09
Procedure Type: Public Function
Module: Functors
Lines of Code: 22
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_09(Note_ID, Note_Title, Note_Text)
0002'Insert Plans for Near Future into Status Reports
0003Dim rs As Recordset
0004Dim Note_Text_Local As String
0005Dim Note_Text_Local_2 As String
0006Note_Text_Local = ""
0007If Note_ID = 520 Then
0008 OK = Functor_06("Development_Log_List_Outstanding_Own_Category_Pri1", Note_Text_Local)
0009 OK = Functor_06("Development_Log_List_Outstanding_Others_Category_Pri1", Note_Text_Local_2)
0010 If OK = "Yes" Then
0011 Note_Text_Local = "|II||1|<b><u>Own Website</u>:</b> " & Note_Text_Local & "|1|<b><u>Other Websites</u>:</b> " & Note_Text_Local_2 & "|II|"
0012 End If
0013Else
0014 Set rs = CurrentDb.OpenRecordset("SELECT Near_Future_Plans.Near_Future_Plan FROM Near_Future_Plans WHERE (((Near_Future_Plans.Note_ID)=" & Note_ID & "));")
0015 If Not rs.EOF Then
0016 rs.MoveFirst
0017 Note_Text_Local = rs.Fields(0)
0018 End If
0019End If
0020Note_Text = Note_Text_Local
0021Functor_09 = "Yes"
0022End Function

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


Source Code of: LogStats
Procedure Type: Public Sub
Module: LazyLibrarian
Lines of Code: 13

Line-No. / Ref.Code Line
0001Public Sub LogStats()
0002Dim rsStatsTable As Recordset
0003'Add Database Record for subsequent reporting
0004 Set rsStatsTable = CurrentDb.OpenRecordset("Select * from LibraryStatsTable where Timestamp is null;")
0005rsStatsTable.AddNew
0006rsStatsTable.Fields(1) = Vols
0007rsStatsTable.Fields(2) = Test
0008rsStatsTable.Fields(3) = Iteration
0009rsStatsTable.Fields(4) = TestDuration
0010rsStatsTable.Fields(5) = Now()
0011rsStatsTable.Update
0012Debug.Print Now() & " - " & "Test: " & Test & "; Iterations: " & Iteration
0013End Sub

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


Source Code of: WebpageGenDud_Abstracts_Papers
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 28
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenDud_Abstracts_Papers()
0002Dim rst As Recordset
0003 strControlTable = "Dud_Abstracts_Papers"
0004 strOutputFileShort = "Dud_Abstracts_Papers"
0005strOutputFolder = TheoWebsiteRoot & "\"
0006strOutputFile = strOutputFolder & strOutputFileShort
0007 strDataQuery = "Dud_Abstracts_Papers"
0008strSplitTable = "No"
0009strControlBreakType = "Initial"
0010strControlBreakType2 = ""
0011Main_Header = "No"
0012Set rst = CurrentDb.OpenRecordset(strDataQuery)
0013If Not rst.EOF Then
0014 Set rst = Nothing
0015 If MsgBox("Did you intend there to be a dud paper abstract? If not, reply ""No""", vbYesNo) = vbYes Then
0016 CreatePapersWebTable
0017 DoCmd.Close acQuery, "Dud_Abstracts_Papers_Updateable"
0018 DoCmd.OpenQuery ("Dud_Abstracts_Papers_Updateable")
0019 Else
0020 DoCmd.Close acQuery, "Dud_Abstracts_Papers_Updateable"
0021 DoCmd.OpenQuery ("Dud_Abstracts_Papers_Updateable")
0022 End If
0023Else
0024 Set rst = Nothing
0025 'Create "empty" page
0026 CreatePapersWebTable
0027End If
0028End Sub

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


© Theo Todman, June 2007 - May 2025. 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