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: 203
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 strQuery As String
0008Dim iUpdates As Long
0009Dim iUpdates_Total As Long
0010Dim Duration As Single
0011Dim RunStartTime As Date
0012Dim strKeyWord As String
0013Dim Object_Type As String
0014Dim iObject_ID As Integer
0015Dim strObject_Text As String
0016Dim i As Long
0017Dim k As Long
0018Dim Link_OK As Boolean
0019Dim The_Word As String
0020Dim The_Word_OK As Boolean
0021Dim Update_Object As Boolean
0022Dim Updating_Run_Notes As Boolean
0023Dim Update_Notes_Archive As Boolean
0024Dim iCounter As Integer
0025iUpdates_Total = 0
0026Updating_Run_Notes = False
0027RunStartTime = Now()
0028'Clear the Notes_To_Regen table ...
0029 strQuery = "DELETE * FROM Notes_To_Regen;"
0030DoCmd.RunSQL (strQuery)
0031'Read & process the objects - Notes, Paper Abstracts, Comments, Book Abstracts, Comments, ...
0032For iCounter = 1 To 14 '... For testing!
0033 iUpdates = 0
0034 Select Case iCounter
0035 Case 1
0036 strQuery = "SELECT Notes.ID, Notes.Item_Text, Notes.Status FROM Notes WHERE (((Notes.Item_Text) Like ""*++++*"")) ORDER BY Notes.ID;"
0037 strKeyWord = "++++"
0038 Object_Type = "Notes"
0039 Case 2
0040 strQuery = "SELECT Notes.ID, Notes.Item_Text, Notes.Status FROM Notes WHERE (((Notes.Item_Text) Like ""*+NN+*"")) ORDER BY Notes.ID;"
0041 strKeyWord = "+NN+"
0042 Object_Type = "Notes"
0043 Case 3
0044 strQuery = "SELECT Authors.Author_ID, Authors.Author_Narrative FROM Authors WHERE (((Authors.Author_Narrative) Like ""*++++*"")) ORDER BY Authors.Author_ID;"
0045 strKeyWord = "++++"
0046 Object_Type = "Authors"
0047 Case 4
0048 strQuery = "SELECT Authors.Author_ID, Authors.Author_Narrative FROM Authors WHERE (((Authors.Author_Narrative) Like ""*+NN+*"")) ORDER BY Authors.Author_ID;"
0049 strKeyWord = "+NN+"
0050 Object_Type = "Authors"
0051 Case 5
0052 strQuery = "SELECT Papers.ID, Papers.Abstract FROM Papers WHERE (((Papers.Abstract) Like ""*++++*"")) ORDER BY Papers.ID;"
0053 strKeyWord = "++++"
0054 Object_Type = "Paper Abstracts"
0055 Case 6
0056 strQuery = "SELECT Papers.ID, Papers.Abstract FROM Papers WHERE (((Papers.Abstract) Like ""*+NN+*"")) ORDER BY Papers.ID;"
0057 strKeyWord = "+NN+"
0058 Object_Type = "Paper Abstracts"
0059 Case 7
0060 strQuery = "SELECT Papers.ID, Papers.Comments FROM Papers WHERE (((Papers.Comments) Like ""*++++*"")) ORDER BY Papers.ID;"
0061 strKeyWord = "++++"
0062 Object_Type = "Paper Comments"
0063 Case 8
0064 strQuery = "SELECT Papers.ID, Papers.Comments FROM Papers WHERE (((Papers.Comments) Like ""*+NN+*"")) ORDER BY Papers.ID;"
0065 strKeyWord = "+NN+"
0066 Object_Type = "Paper Comments"
0067 Case 9
0068 strQuery = "SELECT Books.ID1, Books.Abstract FROM Books WHERE (((Books.Abstract) Like ""*++++*"")) ORDER BY Books.ID1;"
0069 strKeyWord = "++++"
0070 Object_Type = "Book Abstracts"
0071 Case 10
0072 strQuery = "SELECT Books.ID1, Books.Abstract FROM Books WHERE (((Books.Abstract) Like ""*+NN+*"")) ORDER BY Books.ID1;"
0073 strKeyWord = "+NN+"
0074 Object_Type = "Book Abstracts"
0075 Case 11
0076 strQuery = "SELECT Books.ID1, Books.Comments FROM Books WHERE (((Books.Comments) Like ""*++++*"")) ORDER BY Books.ID1;"
0077 strKeyWord = "++++"
0078 Object_Type = "Book Comments"
0079 Case 12
0080 strQuery = "SELECT Books.ID1, Books.Comments FROM Books WHERE (((Books.Comments) Like ""*+NN+*"")) ORDER BY Books.ID1;"
0081 strKeyWord = "+NN+"
0082 Object_Type = "Book Comments"
0083 Case 13
0084 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text FROM Notes_Archive WHERE (((Notes_Archive.Item_Text) Like ""*++++*"")) ORDER BY Notes_Archive.ID;"
0085 strKeyWord = "++++"
0086 Object_Type = "Notes_Archive"
0087 Case 14
0088 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text FROM Notes_Archive WHERE (((Notes_Archive.Item_Text) Like ""*+NN+*"")) ORDER BY Notes_Archive.ID;"
0089 strKeyWord = "+NN+"
0090 Object_Type = "Notes_Archive"
0091 End Select
0092 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0093 If Not rsObject.EOF Then
0094 rsObject.MoveFirst
0095 Do Until rsObject.EOF
0096 iObject_ID = rsObject.Fields(0)
0097 strObject_Text = rsObject.Fields(1)
0098 Update_Object = False
0099 If iCounter >= 1 And iCounter <= 2 Then 'Notes only!
0100 Update_Notes_Archive = False
0101 'Check the Archived Note
0102 If rsObject.Fields(2) = "Temp" Then
0103 'Don't bother for Temp Notes
0104 Else
0105 'Find the latest Archive Note
0106 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;"
0107 Set rsKeyWords_Update = CurrentDb.OpenRecordset(strQuery)
0108 If Not rsKeyWords_Update.EOF Then
0109 If strObject_Text = rsKeyWords_Update.Fields(1) Then
0110 Update_Notes_Archive = True
0111 End If
0112 End If
0113 End If
0114 End If
0115 'Find the next strKeyWord
0116 i = 1
0117 Link_OK = False
0118 Do Until i = 0
0119 i = InStr(i, strObject_Text, strKeyWord)
0120 If i > 0 Then
0121 Link_OK = True
0122 Else
0123 Link_OK = False
0124 End If
0125 If Link_OK = True Then
0126 k = FindWord(strObject_Text, i, "]") 'Find Start of word
0127 If k > 1 Then
0128 The_Word_OK = True
0129 The_Word = Mid(strObject_Text, k, i - k)
0130 'Check no Bracket at start ... if so, probably already bagged!
0131 If Mid(strObject_Text, i - 1, 1) = "]" Then
0132 The_Word = Mid(The_Word, 2, Len(The_Word) - 2)
0133 End If
0134 'Translate ...
0135 strQuery = "SELECT Note_Alternates.ID FROM Note_Alternates WHERE (((Note_Alternates.Item_Alt_Title)=""" & The_Word & """));"
0136 Set rsKeyWords = CurrentDb.OpenRecordset(strQuery)
0137 If rsKeyWords.EOF Then
0138 Debug.Print Now() & " - "; "Incorrect Keyword: "; Object_Type; iObject_ID; The_Word
0139 Else
0140 rsKeyWords.MoveFirst
0141 strObject_Text = Left(strObject_Text, i + 1) & rsKeyWords.Fields(0) & Mid(strObject_Text, i + 2)
0142 Update_Object = True
0143 End If
0144 End If
0145 If The_Word_OK = True Then
0146 'Write out to Notes_To_Regen if it doesn't already exist
0147 If iCounter >= 1 And iCounter <= 2 Then 'Notes only!
0148 Updating_Run_Notes = True
0149 strQuery = "SELECT * FROM Notes_To_Regen WHERE Note_ID=" & iObject_ID & ";"
0150 Set rsNotes_To_Regen = CurrentDb.OpenRecordset(strQuery)
0151 If rsNotes_To_Regen.EOF Then
0152 rsNotes_To_Regen.AddNew
0153 rsNotes_To_Regen.Fields(0) = iObject_ID
0154 rsNotes_To_Regen.Fields(1) = Now()
0155 rsNotes_To_Regen.Update
0156 End If
0157 End If
0158 End If
0159 i = i + 1
0160 End If
0161 Loop
0162 If Update_Object = True Then
0163 iUpdates = iUpdates + 1
0164 'Update the Object
0165 rsObject.Edit
0166 rsObject.Fields(1) = strObject_Text
0167 rsObject.Update
0168 If iCounter >= 1 And iCounter <= 2 Then 'Notes only!
0169 If Update_Notes_Archive = True Then
0170 rsKeyWords_Update.Edit
0171 rsKeyWords_Update.Fields(1) = strObject_Text
0172 rsKeyWords_Update.Update
0173 iUpdates_Total = iUpdates_Total + 1
0174 End If
0175 End If
0176 End If
0177 rsObject.MoveNext
0178 Loop
0179 End If
0180 Debug.Print Now() & " - "; Object_Type; " "; strKeyWord; iUpdates; "Updates"
0181 iUpdates_Total = iUpdates_Total + iUpdates
0182Next iCounter
0183'Output the Notes Pages
0184If Updating_Run_Notes = True Then 'Allow for testing
0185 Archive_Notes_Now = "No"
0186 Regenerate_the_Links = "No"
0187 Regen_Notes_Only = "Yes"
0188 CreateNotesWebPages
0189End If
0190'Tidy Up
0191Set rsKeyWords = Nothing
0192Set rsObject = Nothing
0193Set rsNotes_To_Regen = Nothing
0194Set rsKeyWords_Update = Nothing
0195Debug.Print Now() & " - "; " Total"; iUpdates_Total; "Updates"
0196Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0197If Duration < 1 Then
0198 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0199 MsgBox "Automatic Note Linkage Translations Completed in " & Duration & " seconds. " & iUpdates_Total & " changes made.", vbOKOnly, "Automatic Note Linkages"
0200Else
0201 MsgBox "Automatic Note Linkages Translations Completed in " & Duration & " minutes. " & iUpdates_Total & " changes made.", vbOKOnly, "Automatic Note Linkages"
0202End If
0203End 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 currently 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: 233
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 = 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 YTD_Overall_Percent_Plan = YTDPlan / YTDPlan_Overall * 100
0198End If
0199Set rs = Nothing
0200If Note_ID = 512 Then
0201 Note_Text_Local = "|.|In " & strQuarter_Short
0202 Note_Text_Local = Note_Text_Local & " I spent across my various projects " & Round(QTDHrs_Total, 2)
0203 Note_Text_Local = Note_Text_Local & " hours (" & Round(YTDHrs_Total, 2)
0204 Note_Text_Local = Note_Text_Local & " hours YTD) – where by ""YTD"" - Year to Date - I mean the academic year commencing in " & str_Period_Start
0205 Note_Text_Local = Note_Text_Local & ". ""Actual versus plan"" was " & Round(QTDHrs_Total / QTDPlan_Overall * 100, 1)
0206 Note_Text_Local = Note_Text_Local & "%, (" & Round(YTDHrs_Total / YTDPlan_Overall * 100, 1)
0207 Note_Text_Local = Note_Text_Local & "% YTD)."
0208Else
0209 If QTDPlan = 0 Then
0210 Note_Text_Local = "<B><U>Summary of Progress during " & Right(iReporting_Year, 2) & "Q4" & " - " & Current_Qtr
0211 Note_Text_Local = Note_Text_Local & "</B></U>|99||1|I have spent " & Round(YTDHrs, 2)
0212 Note_Text_Local = Note_Text_Local & " hours YTD on this Project, or related work, where for ""YTD"" - Year to Date - I mean the (academic) year that commenced in " & str_Period_Start
0213 Note_Text_Local = Note_Text_Local & "). That's " & Round(YTD_Percent_Plan, 1)
0214 Note_Text_Local = Note_Text_Local & "% of the planned" & IIf(YTDPlan = 0, YTDPlan_Footnote, "") & " effort. Overall, " & Round(YTD_Overall_Percent, 1)
0215 Note_Text_Local = Note_Text_Local & "% of my Project effort YTD has been directed towards this project."
0216 Else
0217 Note_Text_Local = "<B><U>Summary of Progress during " & strQuarter_Long
0218 Note_Text_Local = Note_Text_Local & "</B></U>|99||1|I spent " & Round(QTDHrs, 2)
0219 Note_Text_Local = Note_Text_Local & " hours in " & strQuarter_Short
0220 Note_Text_Local = Note_Text_Local & " on this Project, or related work (" & Round(YTDHrs, 2)
0221 Note_Text_Local = Note_Text_Local & " hours YTD, where for ""YTD"" - Year to Date - I mean the (academic) year that commenced in " & str_Period_Start
0222 Note_Text_Local = Note_Text_Local & "). That's " & Round(QTD_Percent_Plan, 1)
0223 Note_Text_Local = Note_Text_Local & "% of the planned effort (" & Round(YTD_Percent_Plan, 1)
0224 Note_Text_Local = Note_Text_Local & "% YTD). Overall, " & Round(QTD_Overall_Percent, 1)
0225 Note_Text_Local = Note_Text_Local & "% of my Project effort in the Quarter was directed towards this project (making " & Round(YTD_Overall_Percent, 1)
0226 Note_Text_Local = Note_Text_Local & "% YTD) - as against " & Round(QTD_Overall_Percent_Plan, 1)
0227 Note_Text_Local = Note_Text_Local & "% planned (" & Round(YTD_Overall_Percent_Plan, 1)
0228 Note_Text_Local = Note_Text_Local & "% YTD)."
0229 End If
0230End If
0231Note_Text = Note_Text_Local
0232Functor_08 = "Yes"
0233End 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_04("Development_Log_List_Outstanding_Own_Category_Pri1", Note_Text_Local, "Pri1")
0009 OK = Functor_04("Development_Log_List_Outstanding_Others_Category_Pri1", Note_Text_Local_2, "Pri1")
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: 29
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 = "C:\Theo's Files\Websites\Theo's Website\"
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 MsgBox ("When fixed, copy Dud_Abstracts_Papers.htm from Web (or from Transfer - if process re-run ""clean"") to C:")
0020 Else
0021 DoCmd.OpenQuery ("Dud_Abstracts_Papers")
0022 OK = CopyToTransfer(strOutputFolder, strOutputFileShort & ".htm", "Dud_Papers_Empty")
0023 End If
0024Else
0025 Set rst = Nothing
0026 'Copy "empty" page
0027 OK = CopyToTransfer(strOutputFolder, strOutputFileShort & ".htm", "Dud_Papers_Empty")
0028End If
0029End 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 - August 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