Line-No. / Ref. | Code Line |
0001 | Public Function Functor_02(strQuery, strNote_Text) |
0002 | 'Development Log report - Completed Items - Date Sequence |
0003 | Dim rs As Recordset |
0004 | Dim strNote_Text_Local |
0005 | Dim Implementation_Period As String |
0006 | Dim Own_Website As Boolean |
0007 | Dim Category As String |
0008 | Dim Development As String |
0009 | Dim Implementation_Period_Saved As String |
0010 | Dim Own_Website_Saved As Boolean |
0011 | Dim Category_Saved As String |
0012 | Dim strPeriod_Text As String |
0013 | Dim Own_Website_First_Done As Boolean |
0014 | Dim Own_Website_First As Boolean |
0015 | strNote_Text_Local = "" |
0016 | Implementation_Period_Saved = "99Q9" |
0017 | strPeriod_Text = "" |
0018 | Category_Saved = "" |
0019 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0020 | If Not rs.EOF Then |
0021 | rs.MoveFirst |
0022 | Functor_02 = "Yes" |
0023 | Else |
0024 | Functor_02 = "No" |
0025 | Exit Function |
0026 | End If |
0027 | Do Until rs.EOF |
0028 | Implementation_Period = rs.Fields(0) & "" |
0029 | Own_Website = rs.Fields(1) |
0030 | Category = rs.Fields(2) & "" |
0031 | Development = rs.Fields(3) |
0032 | If Implementation_Period <> Implementation_Period_Saved Then |
0033 | If Implementation_Period_Saved <> "99Q9" Then |
0034 | 'Finalise Previous Period |
0035 | If Own_Website_First <> Own_Website_Saved Then |
0036 | strPeriod_Text = "|II||1|Own Website|ii|" & strPeriod_Text & "|##||ii||II|" |
0037 | Else |
0038 | strPeriod_Text = "|ii|" & strPeriod_Text & "|##||ii|" |
0039 | End If |
0040 | strPeriod_Text = "|.|" & Implementation_Period_Saved & "" & strPeriod_Text |
0041 | End If |
0042 | 'Ready for next Period |
0043 | Own_Website_First_Done = False |
0044 | Own_Website_First = Own_Website |
0045 | strNote_Text_Local = strNote_Text_Local & strPeriod_Text |
0046 | strPeriod_Text = "" |
0047 | Category_Saved = "" |
0048 | End If |
0049 | If (Own_Website_First <> Own_Website) And (Own_Website_First_Done = False) Then |
0050 | strPeriod_Text = strPeriod_Text & "|##||ii||1|Other Websites|ii|" |
0051 | Own_Website_First_Done = True |
0052 | Category_Saved = "" |
0053 | End If |
0054 | If Category <> Category_Saved Then |
0055 | If Category_Saved <> "" Then |
0056 | strPeriod_Text = strPeriod_Text & "|##||1|" & Category & ":|##|" |
0057 | Else |
0058 | strPeriod_Text = strPeriod_Text & "|1|" & Category & ":|##|" |
0059 | End If |
0060 | End If |
0061 | strPeriod_Text = strPeriod_Text & "|.|" & Development |
0062 | 'Move on ... |
0063 | Implementation_Period_Saved = Implementation_Period |
0064 | Own_Website_Saved = Own_Website |
0065 | Category_Saved = Category |
0066 | rs.MoveNext |
0067 | Loop |
0068 | 'Finish the list ... |
0069 | If Own_Website_First <> Own_Website_Saved Then |
0070 | strPeriod_Text = strPeriod_Text & "|##||ii||II|" |
0071 | Else |
0072 | strPeriod_Text = "|ii|" & strPeriod_Text & "|##||ii|" |
0073 | End If |
0074 | strPeriod_Text = "|.|" & Implementation_Period_Saved & "" & strPeriod_Text |
0075 | strNote_Text_Local = strNote_Text_Local & strPeriod_Text |
0076 | 'Top and Tail |
0077 | strNote_Text_Local = "[Items Completed In]++FN|..||.|There have been continual changes and bug-fixes that are not worth reporting. |.|A quarterly release - or the equivalent - of small changes is to be understood passim. |.|There were gaps in the development log that have been filled in from old reports. I've ignored developments for now-defunct sites. |.|However, for my own site I've erred in the direction of plenitude to remind me of what went on. I may prune the list in due course. |..|++:- |..|" & strNote_Text_Local & "|..|" |
0078 | 'Tidy up |
0079 | Set rs = Nothing |
0080 | strNote_Text = strNote_Text_Local |
0081 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Function Functor_03(strQuery, strNote_Text) |
0002 | 'Development Log report - Outstanding Items by Priority |
0003 | Dim rs As Recordset |
0004 | Dim strNote_Text_Local |
0005 | Dim Priority As Integer |
0006 | Dim Category As String |
0007 | Dim Status As String |
0008 | Dim Development As String |
0009 | Dim Priority_Saved As String |
0010 | Dim strPriority_Text As String |
0011 | Dim strPriority_Displayed As String |
0012 | Dim Category_Saved As String |
0013 | Dim strCategory_Text As String |
0014 | strNote_Text_Local = "" |
0015 | Priority_Saved = 0 |
0016 | strPriority_Text = "" |
0017 | Category_Saved = "ZZZZ" |
0018 | strCategory_Text = "" |
0019 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0020 | If Not rs.EOF Then |
0021 | rs.MoveFirst |
0022 | Functor_03 = "Yes" |
0023 | Else |
0024 | Functor_03 = "No" |
0025 | Exit Function |
0026 | End If |
0027 | Do Until rs.EOF |
0028 | Priority = rs.Fields(0) |
0029 | Category = rs.Fields(1) & "" |
0030 | Status = rs.Fields(2) & "" |
0031 | Development = rs.Fields(3) & "" |
0032 | If Category <> Category_Saved Or Priority <> Priority_Saved Then |
0033 | If Category_Saved <> "ZZZZ" Then |
0034 | 'Finalise Previous Category |
0035 | strCategory_Text = "|##|" & strCategory_Text & "|##|" |
0036 | strCategory_Text = "|1|" & Category_Saved & "" & strCategory_Text |
0037 | End If |
0038 | 'Ready for next Period |
0039 | strPriority_Text = strPriority_Text & strCategory_Text |
0040 | strCategory_Text = "" |
0041 | End If |
0042 | If Priority <> Priority_Saved Then |
0043 | If Priority_Saved <> 0 Then |
0044 | 'Finalise Previous Priority |
0045 | strPriority_Text = "|ii|" & strPriority_Text & "|ii|" |
0046 | Select Case Priority_Saved |
0047 | Case 8 |
0048 | strPriority_Displayed = "Work-arounds" |
0049 | Case 9 |
0050 | strPriority_Displayed = "Cancelled Developments" |
0051 | Case Else |
0052 | strPriority_Displayed = "Priority: " & Priority_Saved |
0053 | End Select |
0054 | strPriority_Text = "|.|" & strPriority_Displayed & "" & strPriority_Text |
0055 | End If |
0056 | 'Ready for next Period |
0057 | strNote_Text_Local = strNote_Text_Local & strPriority_Text |
0058 | strPriority_Text = "" |
0059 | strCategory_Text = "" |
0060 | Category_Saved = "ZZZZ" |
0061 | End If |
0062 | strCategory_Text = strCategory_Text & "|.|" & Development & IIf(Priority < 8, IIf(Status = "", "", IIf(Right(Trim(Development), 1) = "|", "", " ") & "→ " & Status & ""), "") |
0063 | 'Move on ... |
0064 | Priority_Saved = Priority |
0065 | Category_Saved = Category |
0066 | rs.MoveNext |
0067 | Loop |
0068 | 'Finish the list ... |
0069 | strCategory_Text = "|##|" & strCategory_Text & "|##|" |
0070 | strCategory_Text = "|1|" & Category_Saved & "" & strCategory_Text |
0071 | strPriority_Text = strPriority_Text & strCategory_Text |
0072 | strPriority_Text = "|ii|" & strPriority_Text & "|ii|" |
0073 | Select Case Priority_Saved |
0074 | Case 8 |
0075 | strPriority_Displayed = "Work-arounds" |
0076 | Case 9 |
0077 | strPriority_Displayed = "Cancelled Developments" |
0078 | Case Else |
0079 | strPriority_Displayed = "Priority: " & Priority_Saved |
0080 | End Select |
0081 | strPriority_Text = "|.|" & strPriority_Displayed & "" & strPriority_Text |
0082 | strNote_Text_Local = strNote_Text_Local & strPriority_Text |
0083 | 'Top and Tail |
0084 | strNote_Text_Local = "Outstanding Items By Priority:- |..|" & strNote_Text_Local & "|..|" |
0085 | 'Tidy up |
0086 | Set rs = Nothing |
0087 | strNote_Text = strNote_Text_Local |
0088 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Function Functor_04(strQuery, strNote_Text) |
0002 | 'Website - Outstanding Developments - Outstanding Items by Category |
0003 | Dim rs As Recordset |
0004 | Dim strNote_Text_Local |
0005 | Dim Priority As Integer |
0006 | Dim Category As String |
0007 | Dim Status As String |
0008 | Dim Development As String |
0009 | Dim Priority_Saved As String |
0010 | Dim strPriority_Text As String |
0011 | Dim strPriority_Displayed As String |
0012 | Dim Category_Saved As String |
0013 | Dim strCategory_Text As String |
0014 | strNote_Text_Local = "" |
0015 | Priority_Saved = 0 |
0016 | strPriority_Text = "" |
0017 | Category_Saved = "ZZZZ" |
0018 | strCategory_Text = "" |
0019 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0020 | If Not rs.EOF Then |
0021 | rs.MoveFirst |
0022 | Functor_04 = "Yes" |
0023 | Else |
0024 | Functor_04 = "No" |
0025 | Exit Function |
0026 | End If |
0027 | Do Until rs.EOF |
0028 | Category = rs.Fields(0) & "" |
0029 | Priority = rs.Fields(1) |
0030 | Status = rs.Fields(2) & "" |
0031 | Development = rs.Fields(3) & "" |
0032 | If Priority <> Priority_Saved Or Category <> Category_Saved Then |
0033 | If Priority_Saved <> 0 Then |
0034 | 'Finalise Previous Priority |
0035 | strPriority_Text = "|##|" & strPriority_Text & "|##|" |
0036 | Select Case Priority_Saved |
0037 | Case 8 |
0038 | strPriority_Displayed = "Work-arounds" |
0039 | Case 9 |
0040 | strPriority_Displayed = "Cancelled Developments" |
0041 | Case Else |
0042 | strPriority_Displayed = "Priority: " & Priority_Saved |
0043 | End Select |
0044 | strPriority_Text = "|.|" & strPriority_Displayed & "" & strPriority_Text |
0045 | End If |
0046 | 'Ready for next Period |
0047 | strCategory_Text = strCategory_Text & strPriority_Text |
0048 | strPriority_Text = "" |
0049 | End If |
0050 | If Category <> Category_Saved Then |
0051 | If Category_Saved <> "ZZZZ" Then |
0052 | 'Finalise Previous Category |
0053 | strCategory_Text = "|..|" & strCategory_Text & "|..|" |
0054 | strCategory_Text = "|1|" & Category_Saved & "" & strCategory_Text |
0055 | End If |
0056 | 'Ready for next Category |
0057 | strNote_Text_Local = strNote_Text_Local & strCategory_Text |
0058 | strCategory_Text = "" |
0059 | strPriority_Text = "" |
0060 | End If |
0061 | strPriority_Text = strPriority_Text & "|.|" & Development & IIf(Priority < 8, IIf(Status = "", "", IIf(Right(Trim(Development), 1) = "|", "", " ") & "→ " & Status & ""), "") |
0062 | 'Move on ... |
0063 | Priority_Saved = Priority |
0064 | Category_Saved = Category |
0065 | rs.MoveNext |
0066 | Loop |
0067 | 'Finish the list ... |
0068 | strPriority_Text = "|##|" & strPriority_Text & "|##|" |
0069 | Select Case Priority_Saved |
0070 | Case 8 |
0071 | strPriority_Displayed = "Work-arounds" |
0072 | Case 9 |
0073 | strPriority_Displayed = "Cancelled Developments" |
0074 | Case Else |
0075 | strPriority_Displayed = "Priority: " & Priority_Saved |
0076 | End Select |
0077 | strPriority_Text = "|.|" & strPriority_Displayed & "" & strPriority_Text |
0078 | strCategory_Text = strCategory_Text & strPriority_Text |
0079 | strCategory_Text = "|..|" & strCategory_Text & "|..|" |
0080 | strCategory_Text = "|1|" & Category_Saved & "" & strCategory_Text |
0081 | strNote_Text_Local = strNote_Text_Local & strCategory_Text |
0082 | 'Top and Tail |
0083 | strNote_Text_Local = "Outstanding Items By Category:- |ii|" & strNote_Text_Local & "|ii|" |
0084 | 'Tidy up |
0085 | Set rs = Nothing |
0086 | strNote_Text = strNote_Text_Local |
0087 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Function Functor_10(Note_ID, Note_Title, Note_Text) |
0002 | 'Insert Plans for Near Future into Summary Status Report |
0003 | Dim rs As Recordset |
0004 | Dim rs2 As Recordset |
0005 | Dim strQuery As String |
0006 | Dim Note_Text_Local As String |
0007 | Dim Note_Text_Sub_Report As String |
0008 | Dim Project_ID As Integer |
0009 | Dim Project_Name As String |
0010 | Dim strPeriod As String |
0011 | Dim strWeeklyPlan As String |
0012 | strQuery = "SELECT Projects.Priority, Projects.Project_Name, Projects.Status_Note FROM Projects WHERE (((Projects.Status_Note) > 0)) ORDER BY Projects.Priority;" |
0013 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0014 | 'Add the pick-list |
0015 | rs.MoveFirst |
0016 | Note_Text_Local = "|99|" |
0017 | Do While Not rs.EOF |
0018 | Project_ID = rs.Fields(2) |
0019 | Project_Name = rs.Fields(1) |
0020 | Note_Text_Local = Note_Text_Local & "|1|" & Project_Name & "" |
0021 | rs.MoveNext |
0022 | Loop |
0023 | Note_Text_Local = Note_Text_Local & "|99|" |
0024 | 'Add the details |
0025 | rs.MoveFirst |
0026 | Note_Text_Local = Note_Text_Local & "|99|" |
0027 | Do While Not rs.EOF |
0028 | Project_ID = rs.Fields(2) |
0029 | Project_Name = rs.Fields(1) |
0030 | OK = Functor_09(Project_ID, Project_Name, Note_Text_Sub_Report) |
0031 | 'Find the planned hours ... |
0032 | strPeriod = Year(Now()) & "-" & Right(100 + Month(Now()), 2) |
0033 | strQuery = "SELECT Project_Plans.Project, Project_Plans.Period, Project_Plans.Weekly_Hours FROM Project_Plans WHERE (((Project_Plans.Project)=""" & Project_Name & """) AND ((Project_Plans.Period)=""" & strPeriod & """));" |
0034 | Set rs2 = CurrentDb.OpenRecordset(strQuery) |
0035 | If rs2.EOF Then |
0036 | strWeeklyPlan = "" |
0037 | Else |
0038 | rs2.MoveFirst |
0039 | strWeeklyPlan = rs2.Fields(2) |
0040 | If strWeeklyPlan = 1 Then |
0041 | strWeeklyPlan = strWeeklyPlan & " hour" |
0042 | Else |
0043 | strWeeklyPlan = strWeeklyPlan & " hours" |
0044 | End If |
0045 | strWeeklyPlan = " (" & strWeeklyPlan & " per week)" |
0046 | End If |
0047 | Set rs2 = Nothing |
0048 | Note_Text_Local = Note_Text_Local & "" & "|1|[" & Project_Name & "]++" & Project_ID & "++" & strWeeklyPlan & Note_Text_Sub_Report |
0049 | rs.MoveNext |
0050 | Loop |
0051 | 'Finish Off |
0052 | Note_Text_Local = Note_Text_Local & "|99|" |
0053 | Note_Text = Note_Text_Local |
0054 | Set rs = Nothing |
0055 | Functor_10 = "Yes" |
0056 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Function WebEncode(strLineIn) |
0002 | ' This is a new routine to convert hard-coded external hyperlinks into my +WW+ format: |
0003 | ' These are added to WebRefs_Table if not already there |
0004 | ' The function returns the line passed updated with the +WW+s (the parameter is unchanged) |
0005 | Dim z As Long |
0006 | Dim zz As Long |
0007 | Dim Y As Long |
0008 | Dim yy As Long |
0009 | Dim i As Long |
0010 | Dim j As Long |
0011 | Dim strHTTP As String |
0012 | Dim strLine As String |
0013 | Dim FindChar As String |
0014 | Dim strWebref1 As String |
0015 | Dim Special_Search As String |
0016 | Dim rsWebRefs As Recordset |
0017 | strLine = strLineIn |
0018 | z = 1 |
0019 | Do While z > 0 |
0020 | 'Find the next Weblink-start |
0021 | Y = InStr(z, strLine, "http") |
0022 | yy = InStr(z, strLine, "www") |
0023 | If yy > 0 Then |
0024 | If Mid(strLine, yy - 1, 1) = "/" Then 'Fudge for URLs with "/www" embedded in them (also applies to http://www, of course, but then http is prior to www |
0025 | yy = 0 |
0026 | End If |
0027 | End If |
0028 | If Y + yy > 0 Then 'There is a link ... |
0029 | 'Give preceedence to the earlier found link .. |
0030 | If Y = 0 Then 'So, it was www |
0031 | Y = yy |
0032 | strHTTP = "http://" 'Need to prefix http |
0033 | Else |
0034 | If yy = 0 Then |
0035 | strHTTP = "" 'It was http, so don't need to prefix http |
0036 | Else |
0037 | If yy < Y Then 'So, it was www |
0038 | Y = yy |
0039 | strHTTP = "http://" 'Need to prefix http |
0040 | Else |
0041 | strHTTP = "" 'It was http, so don't need to prefix http |
0042 | End If |
0043 | End If |
0044 | End If |
0045 | If InStr(Mid(strLine, IIf(Y > 10, Y - 10, 1), 10), "HREF") > 0 Then 'Fudge in case Weblink is at the start of the text! |
0046 | 'Already had manually-encoded Web Ref, so ignore ... |
0047 | strWebref1 = "DummyDummy" |
0048 | Else |
0049 | 'Now check for the "special" prefix ... "WRx" where x is the delimeter |
0050 | Special_Search = "No" |
0051 | If Y > 2 Then |
0052 | 'Check for embedded search-character |
0053 | If Mid(strLine, Y - 3, 2) = "WR" Then |
0054 | Special_Search = "Yes" |
0055 | Else |
0056 | Special_Search = "No" |
0057 | End If |
0058 | End If |
0059 | If Special_Search = "Yes" Then |
0060 | FindChar = Mid(strLine, Y - 1, 1) |
0061 | strLine = Left(strLine, Y - 4) & Mid(strLine, Y) |
0062 | Y = Y - 3 |
0063 | 'The start has been found ... now find the end ... |
0064 | z = InStr(Y, strLine, FindChar) 'Assumes we've been careful! |
0065 | Else |
0066 | 'The start has been found ... now find the end ... |
0067 | 'Check for an open-ended list of delimiters that CANNOT themselves be part of a Weblink - if the function fails, look to add to these! ************ |
0068 | z = InStr(Y, strLine, " ") |
0069 | zz = InStr(Y, strLine, Chr(9)) |
0070 | If z = 0 Or (zz > 0 And z > zz) Then |
0071 | z = zz |
0072 | End If |
0073 | zz = InStr(Y, strLine, Chr(10)) |
0074 | If z = 0 Or (zz > 0 And z > zz) Then |
0075 | z = zz |
0076 | End If |
0077 | zz = InStr(Y, strLine, Chr(13)) |
0078 | If z = 0 Or (zz > 0 And z > zz) Then |
0079 | z = zz |
0080 | End If |
0081 | zz = InStr(Y, strLine, "<") |
0082 | If z = 0 Or (zz > 0 And z > zz) Then |
0083 | z = zz |
0084 | End If |
0085 | zz = InStr(Y, strLine, ")") 'Actually, this can be, and there's a corrective fudge later on ... |
0086 | If z = 0 Or (zz > 0 And z > zz) Then |
0087 | If zz > 0 Then |
0088 | strWebref1 = Mid(strLine, Y, zz - Y) |
0089 | If InStr(strWebref1, "(") = 0 Then 'The fudge: ")" isn't the terminator if there was a preceeding "(". |
0090 | z = zz |
0091 | End If |
0092 | End If |
0093 | End If |
0094 | zz = InStr(Y, strLine, "|") |
0095 | If z = 0 Or (zz > 0 And z > zz) Then |
0096 | z = zz |
0097 | End If |
0098 | zz = InStr(Y, strLine, ";") |
0099 | If z = 0 Or (zz > 0 And z > zz) Then |
0100 | z = zz |
0101 | End If |
0102 | zz = InStr(Y, strLine, ", ") 'Note the space! Commas are allowed within URLs |
0103 | If z = 0 Or (zz > 0 And z > zz) Then |
0104 | z = zz |
0105 | End If |
0106 | End If |
0107 | If z = 0 Then 'Assume the Weblink exhausts strLine |
0108 | z = Len(strLine) + 1 |
0109 | End If |
0110 | ' Open-ended list of possible terminators that CAN be part of a Weblink - if the function fails, look to add to these! ************ |
0111 | ' Basically assume that these will be followed by a universal delimeter, and can therefore be taken to be the real delimeter ... |
0112 | strWebref1 = Mid(strLine, Y, z - Y) |
0113 | zz = 0 |
0114 | If Mid(strLine, z - 1, 1) = ":" Then |
0115 | zz = 1 |
0116 | End If |
0117 | If Mid(strLine, z - 1, 1) = ")" Then |
0118 | i = Find_Count(strWebref1, ")") |
0119 | j = Find_Count(strWebref1, "(") |
0120 | If i <> j Then 'Ignore matching brackets |
0121 | zz = 1 |
0122 | End If |
0123 | End If |
0124 | If Mid(strLine, z - 1, 1) = "." Then |
0125 | 'Need to watch out for "Jr." ... and maybe others, which I'll add when they occur. |
0126 | If Mid(strLine, z - 3, 3) <> "Jr." Then |
0127 | zz = 1 |
0128 | End If |
0129 | End If |
0130 | strWebref1 = strHTTP & Mid(strLine, Y, z - Y - zz) |
0131 | If strWebref1 & "" <> "" Then |
0132 | If Len(strWebref1) > 12 Then 'Check for HTTP as text! |
0133 | If InStr(strWebref1, """") > 0 Then 'Fudge ... |
0134 | Else |
0135 | Set rsWebRefs = CurrentDb.OpenRecordset("SELECT Webrefs_Table.* FROM Webrefs_Table WHERE (((Webrefs_Table.Webref)=""" & strWebref1 & """));") |
0136 | If rsWebRefs.EOF Then |
0137 | rsWebRefs.AddNew |
0138 | rsWebRefs.Fields(1) = Left(strWebref1, 255) '***************** |
0139 | rsWebRefs.Fields(2) = Now() |
0140 | rsWebRefs.Update |
0141 | End If |
0142 | Set rsWebRefs = Nothing |
0143 | Set rsWebRefs = CurrentDb.OpenRecordset("SELECT Webrefs_Table.* FROM Webrefs_Table WHERE (((Webrefs_Table.Webref)=""" & strWebref1 & """));") |
0144 | If Not rsWebRefs.EOF Then |
0145 | strWebref1 = "+W" & rsWebRefs.Fields(0) & "W+" |
0146 | If Special_Search = "Yes" Then |
0147 | strLine = Left(strLine, IIf(Y < 2, 0, (Y - 2))) & strWebref1 & Mid(strLine, z + 1 - zz) |
0148 | Else |
0149 | strLine = Left(strLine, Y - 1) & strWebref1 & Mid(strLine, z - zz) |
0150 | End If |
0151 | End If |
0152 | End If |
0153 | End If |
0154 | End If |
0155 | End If |
0156 | 'Position ready for the next Weblink ... |
0157 | z = Y + Len(strWebref1) |
0158 | Else |
0159 | z = 0 |
0160 | End If |
0161 | Loop |
0162 | WebEncode = strLine |
0163 | End Function |