0233 | strElement = ""
0234 | Case 15, 17, 18, 23, 24, 25, 28, 29, 30, 32 |
0235 | strElement = ""
0236 | Case 7, 8, 26, 27, 34 |
0237 | strElement = ""
0238 | Case 22 |
0239 | strElement = ""
0240 | Case 11, 31 |
0241 | strElement = ""
0242 | Case 12, 13, 20, 37, 38 |
0243 | strElement = ""
0244 | Case 21 |
0245 | strElement = ""
0246 | If strParameter2_Local > 5 Then |
0247 | strElement = ""
0248 | End If |
0249 | If strParameter2_Local > 7 Then |
0250 | strElement = ""
0251 | End If |
0252 | If strParameter2_Local = 10 Then |
0253 | strElement = ""
0254 | End If |
0255 | Case 39, 40 |
0256 | strElement = ""
0257 | Case Else |
0258 | strElement = ""
0259 | End Select |
0260 | strTable_Local = strTable_Local & strElement |
0261 | 'Set up Table Headings |
0262 | strElement = ""
0263 | For i = 1 To iCols |
0264 | strCell = rs.Fields(i - 1).Name |
0265 | Select Case strParameter |
0266 | Case 3 |
0267 | If i = 1 Then |
0268 | strElement = strElement & "" & strCell & " | " |
0269 | Else |
0270 | strElement = strElement & "" & strCell & " | " |
0271 | End If |
0272 | Case 7 |
0273 | If i = 1 Or i = 5 Then |
0274 | strElement = strElement & "" & strCell & " | " |
0275 | Else |
0276 | strElement = strElement & "" & strCell & " | " |
0277 | End If |
0278 | Case 8 |
0279 | If i = 1 Or i = 2 Then |
0280 | strElement = strElement & "" & strCell & " | " |
0281 | Else |
0282 | strElement = strElement & "" & strCell & " | " |
0283 | End If |
0284 | Case 11 |
0285 | If i = 4 Then |
0286 | strElement = strElement & "" & strCell & " | " |
0287 | Else |
0288 | strElement = strElement & "" & strCell & " | " |
0289 | End If |
0290 | Case 15, 17, 18, 23, 24, 25, 27, 28, 29, 30, 32, 34 |
0291 | strElement = strElement & "" & strCell & " | " |
0292 | Case 20 |
0293 | Col_Width = Round(100 / iCols, 1) |
0294 | strElement = strElement & "" & strCell & " | " |
0295 | Case 21 |
0296 | Select Case strParameter2 |
0297 | Case 1, 4 |
0298 | If i > 2 Then |
0299 | strCell = Mid(strCell, 4) |
0300 | End If |
0301 | Case 2, 5 |
0302 | If i > 3 Then |
0303 | strCell = Mid(strCell, 4) |
0304 | End If |
0305 | Case 3 |
0306 | If i > 5 Then |
0307 | strCell = Mid(strCell, 4) |
0308 | End If |
0309 | End Select |
0310 | strElement = strElement & "" & strCell & " | " |
0311 | Case 22 |
0312 | If i = 2 Or i = 3 Then |
0313 | strElement = strElement & "" & strCell & " | " |
0314 | Else |
0315 | strElement = strElement & "" & strCell & " | " |
0316 | End If |
0317 | Case 26 |
0318 | strElement = strElement & "" & strCell & " | " |
0319 | Case 31 |
0320 | strElement = strElement & "" & strCell & " | " |
0321 | Case Else |
0322 | strElement = strElement & "" & strCell & " | " |
0323 | End Select |
0324 | If i = iTotal_Col And strParameter <> 3 Then |
0325 | strElement = strElement & "TOTAL | " |
0326 | End If |
0327 | Next i |
0328 | strElement = strElement & " | " |
0329 | strHeader = strElement & Chr$(10) |
0330 | If strParameter = 30 Or strParameter = 30 Then 'Err .... ******************** |
0331 | strElement = "" |
0332 | End If |
0333 | strTable_Local = strTable_Local & strElement & Chr$(10) |
0334 | 'Set up Table Rows |
0335 | strCell_1_Saved = "" |
0336 | strCell_4_Saved = "" |
0337 | strElement = "" |
0338 | Do Until rs.EOF |
0339 | If strParameter = 11 Or strParameter = 22 Or (strParameter = 21 And (Val(strParameter2_Local) <> 3)) Then |
0340 | If (strCell_1_Saved <> rs.Fields(0)) And (strElement <> "") Then |
0341 | 'Insert a blank row |
0342 | strElement = strElement & ""
0343 | For i = 1 To iCols |
0344 | strElement = strElement & " | " |
0345 | Next i |
0346 | strElement = strElement & " | " |
0347 | 'Insert the header row |
0348 | strElement = strElement & strHeader |
0349 | End If |
0350 | End If |
0351 | 'strElement = strElement & ""
0352 | j = 0 |
0353 | For i = 1 To iCols |
0354 | Select Case i |
0355 | Case 1 |
0356 | strWork = ""
0357 | strCell = rs.Fields(0) & "" |
0358 | If strParameter = 7 Or strParameter = 8 Or strParameter = 11 Or strParameter = 22 Or strParameter = 24 Or strParameter = 30 Or (strParameter = 21 And (Val(strParameter2_Local) <> 3)) Then |
0359 | If (strCell_1_Saved = strCell) And strCell & "" <> "" Then |
0360 | strCell = "↑↑↑" |
0361 | Else |
0362 | strCell_1_Saved = strCell |
0363 | If strParameter = 11 Or strParameter = 22 Then |
0364 | strCell = "+R" & strCell & IIf(strParameter = 22 And Val(strParameter2_Local) > 2, "Dialogue", "") & "R+" & "" & strCell & "" |
0365 | Else |
0366 | If strParameter = 30 Then |
0367 | strWork = Mid(strCell, 2, InStr(strCell, "]") - 2) |
0368 | strWork = "PDFs_" & Replace(strWork, " ", "") |
0369 | strWork = Left(strWork, 20) |
0370 | strWork = " | | |
+R" & strWork & "R+" & strHeader & ""
0371 | End If |
0372 | End If |
0373 | End If |
0374 | If (strParameter = 11 And rs.Fields(1) <> 0) Or strParameter = 22 Then |
0375 | strCell = "+R" & rs.Fields(1) & IIf(strParameter = 22 And Val(strParameter2_Local) > 2, "Dialogue", "") & "R+ " & strCell |
0376 | End If |
0377 | strElement = strElement & strWork & "" & strCell & " | " |
0378 | Else |
0379 | strElement = strElement & strWork |
0380 | If strParameter = 3 Or strParameter = 26 Or strParameter = 27 Or strParameter = 28 Or strParameter = 29 Or strParameter = 32 Or strParameter = 34 Then |
0381 | If strParameter = 26 Then |
0382 | strCell = "..\..\" & strCell |
0383 | strWork2 = Link_Narr_Gen(strCell) & "" |
0384 | If strWork2 = "" Then |
0385 | strWork2 = strCell |
0386 | End If |
0387 | strCell = "" & strWork2 & "" |
0388 | strElement = strElement & "" & strCell & " | " |
0389 | Else |
0390 | strElement = strElement & "" & strCell & " | " |
0391 | End If |
0392 | Else |
0393 | If strParameter = 15 Or strParameter = 17 Or strParameter = 18 Or strParameter = 23 Or strParameter = 24 Or strParameter = 25 Or strParameter = 30 Or strParameter = 31 Then |
0394 | strElement = strElement & "" & strCell & " | " |
0395 | Else |
0396 | strElement = strElement & "" & strCell & " | " |
0397 | End If |
0398 | End If |
0399 | End If |
0400 | Case Else |
0401 | strCell = rs.Fields(i - 1) & "" |
0402 | If strCell = "" Then |
0403 | strCell = " " |
0404 | Else |
0405 | If strParameter = 3 Then |
0406 | If i > 6 Then |
0407 | strCell = Round(strCell, 2) |
0408 | End If |
0409 | End If |
0410 | If i <= iTotal_Col Then |
0411 | j = j + Val(strCell) |
0412 | End If |
0413 | k(i) = k(i) + Val(strCell) |
0414 | If strParameter <> 3 And strParameter <> 26 And strParameter <> 28 And strParameter <> 29 And strParameter <> 32 Then |
0415 | OK = Number_Format(strCell) |
0416 | End If |
0417 | End If |
0418 | If (i = 5 And strParameter = 7) Or (i = 2 And strParameter = 15) Or (i = 2 And strParameter = 17) Or (i = 2 And strParameter = 18) Then |
0419 | If strCell_4_Saved = strCell Then |
0420 | strCell = "↑↑↑" |
0421 | Else |
0422 | strCell_4_Saved = strCell |
0423 | End If |
0424 | End If |
0425 | If i = 3 And strParameter = 3 Then |
0426 | If strCell = "-" Then |
0427 | strCell = " " |
0428 | Else |
0429 | strCell = Oboe_File_Links_List(strCell) |
0430 | End If |
0431 | End If |
0432 | If (strParameter = 3 And i > 1) Or (strParameter = 7 And i < 5) Or (strParameter = 8 And i > 2) Or (strParameter = 11 And i < 4) Then |
0433 | strElement = strElement & "" & strCell & " | " |
0434 | Else |
0435 | If strParameter = 11 And i = 4 Then |
0436 | If rs.Fields(1) = "0" Then |
0437 | strCell = "Administration|..||.|" & strCell & ": " & Language_Animadversion_Reference_List(rs.Fields(0)) |
0438 | 'Add old time |
0439 | strCell = strCell & Subject_Hours_List(rs.Fields(0)) |
0440 | strQuery = "SELECT Language_Location_Primer.Language_Key, Language_Location_Primer.[Non_Latin_Script?], Language_Location_Primer.Ling_Progress FROM Language_Location_Primer WHERE (((Language_Location_Primer.Language_Key)=""" & rs.Fields(0) & """));" |
0441 | Set rs_Temp = CurrentDb.OpenRecordset(strQuery) |
0442 | rs_Temp.MoveFirst |
0443 | If rs_Temp.Fields(2) > 0 Then |
0444 | 'Add latest Ling Lesson |
0445 | strCell = strCell & "|.|Latest Ling Lesson Studied: " & rs_Temp.Fields(2) |
0446 | 'Add Links to Ling XTabs |
0447 | strCell = strCell & "|.|Links to Aeon Comparative Database: |99|" |
0448 | If rs_Temp.Fields(1) = True Then |
0449 | strCell = strCell & "|1|Vocabulary++1322#" & rs.Fields(0) & "++|1|Dialogues++1324#" & rs.Fields(0) & "Dialogue++" |
0450 | Else |
0451 | strCell = strCell & "|1|Vocabulary++1321#" & rs.Fields(0) & "++|1|Dialogues++1323#" & rs.Fields(0) & "Dialogue++" |
0452 | End If |
0453 | strCell = strCell & "|99|" |
0454 | Set rs_Temp = Nothing |
0455 | End If |
0456 | 'Finish off |
0457 | strCell = strCell & "|..|" |
0458 | Else |
0459 | strCell = Language_Animadversion_Translate(strCell, rs.Fields(0)) |
0460 | End If |
0461 | End If |
0462 | If (strParameter = 7 And i = 5) Or (strParameter = 8 And i = 2) Or (strParameter = 11 And i = 4) Or strParameter = 15 Or strParameter = 17 Or strParameter = 18 Or strParameter = 22 Or strParameter = 30 Or (strParameter = 21 And (Val(strParameter2_Local) <> 3)) Then |
0463 | strElement = strElement & "" & strCell & " | " |
0464 | Else |
0465 | If strParameter = 23 Then |
0466 | If i = 2 Or i = 4 Or i = 7 Then |
0467 | strElement = strElement & "" & strCell & " | " |
0468 | Else |
0469 | strElement = strElement & "" & strCell & " | " |
0470 | End If |
0471 | Else |
0472 | If strParameter = 24 Or strParameter = 25 Or strParameter = 28 Or strParameter = 29 Or strParameter = 31 Or strParameter = 32 Then |
0473 | strElement = strElement & "" & strCell & " | " |
0474 | Else |
0475 | If strParameter = 26 Then |
0476 | Select Case i |
0477 | Case 2, 3 |
0478 | strElement = strElement & "" & strCell & " | " |
0479 | Case 4 |
0480 | OK = Number_Format(strCell) |
0481 | strElement = strElement & "" & strCell & " | " |
0482 | Case 5 |
0483 | strCell = " " |
0484 | m = InStr(rs.Fields(0), "NotesPrint_") |
0485 | If m > 0 Then |
0486 | m = m + 11 |
0487 | n = InStr(m, rs.Fields(0), "_") |
0488 | If n > 0 Then |
0489 | m = Mid(rs.Fields(0), m, n - m) |
0490 | strCell = "[Note Link]++" & m & "++" |
0491 | End If |
0492 | End If |
0493 | strElement = strElement & "" & strCell & " | " |
0494 | End Select |
0495 | Else |
0496 | strElement = strElement & "" & strCell & " | " |
0497 | End If |
0498 | End If |
0499 | End If |
0500 | End If |
0501 | End If |
0502 | If i = iTotal_Col Then |
0503 | 'Row Total |
0504 | strCell = j |
0505 | If strParameter <> 3 Then |
0506 | OK = Number_Format(strCell) |
0507 | strElement = strElement & "" & strCell & " | " |
0508 | End If |
0509 | k(iCols + 1) = k(iCols + 1) + j |
0510 | End If |
0511 | End Select |
0512 | Next i |
0513 | strElement = strElement & " | " & Chr$(10)
0514 | rs.MoveNext |
0515 | Loop |
0516 | strTable_Local = strTable_Local & strElement |
0517 | 'Set up Total Line |
0518 | If iCols >= iTotal_Col Then 'Allow for no Total Row |
0519 | If strParameter = 3 Then |
0520 | strElement = "TOTALS → | "
0521 | Else |
0522 | strElement = "TOTAL | "
0523 | End If |
0524 | For i = 2 To iCols |
0525 | strCell = k(i) |
0526 | If strParameter <> 3 Then |
0527 | OK = Number_Format(strCell) |
0528 | End If |
0529 | If strCell = 0 Then |
0530 | strCell = " " |
0531 | End If |
0532 | If strParameter = 3 Then |
0533 | If i < 5 Then |
0534 | strElement = strElement & "" & " " & " | " |
0535 | Else |
0536 | strElement = strElement & "" & strCell & " | " |
0537 | End If |
0538 | Else |
0539 | strElement = strElement & "" & strCell & " | " |
0540 | If i = iTotal_Col Then |
0541 | strCell = k(iCols + 1) |
0542 | OK = Number_Format(strCell) |
0543 | strElement = strElement & "" & strCell & " | " |
0544 | End If |
0545 | End If |
0546 | Next i |
0547 | strElement = strElement & "" & Chr$(10)
0548 | strTable_Local = strTable_Local & strElement |
0549 | End If |
0550 | 'Set up Table Footer |
0551 | If strParameter = 3 Or strParameter = 11 Or strParameter = 22 Or (strParameter = 21 And (Val(strParameter2_Local) <> 3)) Then |
0552 | strTable_Local = strTable_Local & strHeader 'Repeat the column headers |
0553 | End If |
0554 | strElement = " | | | | " |
0555 | strTable_Local = strTable_Local & strElement |
0556 | 'Tidy up and exit |
0557 | Functor_21 = "Yes" |
0558 | strTable = strTable_Local |
0559 | Set rs = Nothing |
0560 | End Function |
Procedures Calling This Procedure (Functor_21)
- Auto_Reference_Notes (From Lines 896, 898)
- Functor (From Line 183)
Procedures Called By This Procedure (Functor_21)
Tables / Queries / Fragments Directly Used By This Procedure (Functor_21)
- Auto_Ref_Notes_Stats_Detailed (Query, used in Line 45)
- Auto_Ref_Notes_Stats_Grand_Summary (Query, used in Line 58)
- Auto_Ref_Notes_Stats_Grandest_Summary (Query, used in Line 61)
- Auto_Ref_Notes_Stats_Summary (Query, used in Line 41)
- Bible_Reading_Progress (Query, used in Line 176)
- BookPaperControl_List (Query, used in Line 191)
- Books_To_Regen (Table, used in Line 149)
- Cross_Reference_By_Type (Query, used in Line 32)
- Cross_Reference_Changes_By_Type (Query, used in Line 35)
- Duplicate_Papers (Query, used in Line 167)
- Functor_Calls (Query, used in Line 48)
- Functors_FbyN (Query, used in Line 52)
- Functors_NbyF (Query, used in Line 56)
- IdentityBooks_Unreferenced (Query, used in Line 95)
- IdentityBooks_Unreferenced_Gen (Query, used in Line 96)
- IdentityPapersRead_Unreferenced (Query, used in Line 85)
- IdentityPapersRead_Unreferenced_Gen (Query, used in Line 86)
- Language_Animadversions_List (Query, used in Line 73)
- Language_Animadversions_XTab (Query, used in Line 76)
- Language_Animadversions_XTab_Pri2 (Query, used in Line 79)
- Language_Animadversions_XTab_Pri3 (Query, used in Line 194)
- Language_Animadversions_XTab_Pri4 (Query, used in Line 197)
- Language_Location_Primer (Table, used in Line 440)
- Language_Location_Primer_Date_Time_Updt (Query, used in Line 71)
- Language_Location_Primer_Time_Zap (Query, used in Line 69)
- Large_Page_List (Query, used in Line 161)
- Ling_Database_Summary_XTab_Dialogue_Latin (Query, used in Line 107)
- Ling_Database_Summary_XTab_Dialogue_NonLatin (Query, used in Line 109)
- Ling_Database_Summary_XTab_Vocabulary_Latin (Query, used in Line 103)
- Ling_Database_Summary_XTab_Vocabulary_NonLatin (Query, used in Line 105)
- Ling_Language_Dialogue_List_All (Query, used in Line 119)
- Ling_Language_Dialogue_List_All_ru_uk (Query, used in Line 133)
- Ling_Language_Dialogue_List_Latin (Query, used in Line 143)
- Ling_Language_Dialogue_List_NonLatin (Query, used in Line 145)
- Ling_Language_Vocab_List_All (Query, used in Line 115)
- Ling_Language_Vocab_List_All_LessonSeq (Query, used in Line 121)
- Ling_Language_Vocab_List_All_LessonSeq_ru_uk (Query, used in Line 127)
- Ling_Language_Vocab_List_All_ru_uk (Query, used in Line 125)
- Ling_Language_Vocab_List_Latin (Query, used in Line 139)
- Ling_Language_Vocab_List_NonLatin (Query, used in Line 141)
- Ling_Language_Vocab_Phrase_List_All (Query, used in Line 117)
- Ling_Language_Vocab_Phrase_List_All_LessonSeq (Query, used in Line 123)
- Ling_Language_Vocab_Phrase_List_All_LessonSeq_ru_uk (Query, used in Line 129)
- Ling_Language_Vocab_Phrase_List_All_ru_uk (Query, used in Line 131)
- Missing_Webref_DisplayText_List (Query, used in Line 170)
- Missing_Webref_DisplayText_List_Books (Query, used in Line 179)
- Oboe_Practice_Hours_List (Query, used in Line 38)
- Papers_Inconsistently_Electronic (Query, used in Line 185)
- PDF_Missing_List (Query, used in Line 164)
- PID_Books_To_Regen (Query, used in Line 151)
- PID_Missing_Online_Papers_List (Query, used in Line 173)
- PID_Missing_Online_Papers_List_Summary (Query, used in Line 182)
- PID_Notes_RL_Category_Xtab (Query, used in Line 99)
- PID_Notes_Used_By_Thesis_Chapter_List_XTab (Query, used in Line 89)
- PID_Notes_Used_By_Thesis_Chapter_XTab (Query, used in Line 82)
- PID_Papers_Filed_Not_Referenced (Query, used in Line 152)
- PID_Papers_Referenced_No_Abstract (Query, used in Line 158)
- PID_Papers_Referenced_Undated (Query, used in Line 155)
- Temp_Lang_Date_Last_Study (Table, used in Line 65)
- Temp_Lang_Date_Last_Study_GEN (Query, used in Line 67)
- Time_By_Weekday_QTD (Query, used in Line 203)
- Time_By_Weekday_YTD (Query, used in Line 200)
- Website_Regen_Control_List (Query, used in Line 188)
- Works_Missing_By_Thesis_Chapter (Query, used in Line 92)
Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page
Source Code of: Functor_22 Procedure Type: Public Function Module: Functors Lines of Code: 341
Go To End of This Procedure
Line-No. / Ref. | Code Line |
0001 | Public Function Functor_22(strParameter, strList, Note_ID, str_Parameter_2, Optional str_Parameter_3, Optional str_Parameter_4) 'str_Parameter_3 & _4 to be used for recursion |
0002 | 'This function formats a list (together with surrounding narrative) from a query |
0003 | Dim rs As Recordset |
0004 | Dim strList_Local As String |
0005 | Dim strElement As String |
0006 | Dim strCell As String |
0007 | Dim strQuery As String |
0008 | Dim strUpdtQuery As String |
0009 | Dim BP As String |
0010 | Dim FN As String |
0011 | Dim str_Parameter_2_Local As String |
0012 | Dim str_Parameter_3_Local As String |
0013 | Dim str_Parameter_4_Local As String |
0014 | Dim strPara2 As String |
0015 | Dim strPara3 As String |
0016 | Dim Item_Year As String |
0017 | Dim Write_Up_Note As Long |
0018 | Dim Field_1 As String |
0019 | Dim Field_2 As String |
0020 | Dim Field_3 As String |
0021 | Dim Field_4 As String |
0022 | Dim Chapter_FieldName As String |
0023 | str_Parameter_2_Local = str_Parameter_2 & "" |
0024 | If IsMissing(str_Parameter_3) Then |
0025 | str_Parameter_3_Local = "" |
0026 | Else |
0027 | str_Parameter_3_Local = str_Parameter_3 & "" |
0028 | End If |
0029 | If IsMissing(str_Parameter_4) Then |
0030 | str_Parameter_4_Local = "" |
0031 | Else |
0032 | str_Parameter_4_Local = str_Parameter_4 & "" |
0033 | End If |
0034 | strPara3 = "" |
0035 | 'For Cases 6 to 7 ... Note that this processing is performed for cases 8 & 9 on re-entry |
0036 | If strParameter >= 6 And strParameter <= 7 Then |
0037 | If automatic_processing <> "Yes" Then |
0038 | 'Check Books & Papers on PID_Note_Reading_Lists exist! |
0039 | Set rs = CurrentDb.OpenRecordset("PID_Note_Reading_Lists_Books_Chk") |
0040 | If Not rs.EOF Then |
0041 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_Books_Chk") |
0042 | End If |
0043 | Set rs = Nothing |
0044 | Set rs = CurrentDb.OpenRecordset("PID_Note_Reading_Lists_Papers_Chk") |
0045 | If Not rs.EOF Then |
0046 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_Papers_Chk") |
0047 | End If |
0048 | Set rs = Nothing |
0049 | 'Add new rows to PID_Note_Reading_Lists |
0050 | DoCmd.OpenQuery ("PID_Notes_Books_Referenced_Gen") |
0051 | DoCmd.OpenQuery ("PID_Notes_Papers_Referenced_Gen") |
0052 | DoCmd.OpenQuery ("IdentityBooks_Unreferenced_Gen") |
0053 | DoCmd.OpenQuery ("IdentityPapersRead_Unreferenced_Gen") |
0054 | ' Update/add the authors, titles and the "read" & "annotation" status of the papers on PID_Note_Reading_Lists |
0055 | strUpdtQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN Papers ON PID_Note_Reading_Lists.Called_ID = Papers.ID SET PID_Note_Reading_Lists.[Percent_Read] = Papers.[Actual - Total] / Papers.Estimate * 100, PID_Note_Reading_Lists.[Read?] = [Papers]![Read?], PID_Note_Reading_Lists.Author = [Papers]![Author], PID_Note_Reading_Lists.Title = [Papers]![Title], PID_Note_Reading_Lists.[Annotations?] = [Papers]![Annotations?], PID_Note_Reading_Lists.[Abstract_Null?] = IIf([Abstract] & """"="""",True,False), PID_Note_Reading_Lists.[Link_Internal?] = IIf(InStr([Comments] & """",""+F"")>0,True,False), PID_Note_Reading_Lists.[Link_External?] = IIf(InStr([Comments] & """",""+W"")>0,True,False) WHERE (((PID_Note_Reading_Lists.[Book/Paper])=""Paper"") AND ((PID_Note_Reading_Lists.Note_ID)=" & Note_ID & "));" |
0056 | DoCmd.RunSQL (strUpdtQuery) |
0057 | ' Update/add the authors, titles and the "read" status of the books on PID_Note_Reading_Lists |
0058 | strUpdtQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN Books ON PID_Note_Reading_Lists.Called_ID = Books.ID1 SET PID_Note_Reading_Lists.[Percent_Read] = Books.[Actual - Total] / Books.Estimate * 100, PID_Note_Reading_Lists.[Read?] = [Books]![Read?], PID_Note_Reading_Lists.Author = [Books]![Author], PID_Note_Reading_Lists.Title = [Books]![Title] WHERE (((PID_Note_Reading_Lists.[Book/Paper])=""Book"") AND ((PID_Note_Reading_Lists.Note_ID)=" & Note_ID & "));" |
0059 | DoCmd.RunSQL (strUpdtQuery) |
0060 | 'Update to show Write-up Notes |
0061 | strUpdtQuery = "UPDATE PID_Note_Reading_Lists INNER JOIN Papers ON PID_Note_Reading_Lists.Called_ID = Papers.ID SET PID_Note_Reading_Lists.[Write-Up?] = [Papers]![Write_Up_Note_ID] WHERE (((Papers.Write_Up_Note_ID)>0) AND ((PID_Note_Reading_Lists.[Book/Paper])=""Paper"") AND ((PID_Note_Reading_Lists.Note_ID)=" & Note_ID & "));" |
0062 | DoCmd.RunSQL (strUpdtQuery) |
0063 | End If |
0064 | 'Check if R/L to be de-duplicated |
0065 | If str_Parameter_3_Local = "De-Duplicate" Then |
0066 | 'Determine the column name in PID_Note_Reading_Lists table |
0067 | strQuery = "SELECT Thesis_Chapters.ID, Thesis_Chapters.Chapter FROM Thesis_Chapters WHERE (((Thesis_Chapters.ID)=" & str_Parameter_4 & "));" |
0068 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0069 | If Not rs.EOF Then |
0070 | rs.MoveFirst |
0071 | Chapter_FieldName = rs.Fields(1) |
0072 | Chapter_FieldName = "Ch_" & Chapter_FieldName & "_Ist_Note" |
0073 | strPara3 = " AND ((PID_Note_Reading_Lists." & Chapter_FieldName & ")<>999999)" |
0074 | End If |
0075 | Set rs = Nothing |
0076 | End If |
0077 | End If |
0078 | 'For Cases 6 to 9 ... |
0079 | If strParameter >= 6 And strParameter <= 9 Then |
0080 | 'Over-ride Parameter_2 (Category) if requested, else select only that Category |
0081 | If str_Parameter_2_Local = "*ALL*" Then |
0082 | strPara2 = "" |
0083 | Else |
0084 | If str_Parameter_2_Local = "" Then |
0085 | strPara2 = " AND ((PID_Note_Reading_Lists.Category) & """" = """")" |
0086 | Else |
0087 | strPara2 = " AND ((PID_Note_Reading_Lists.Category)=""" & str_Parameter_2_Local & """)" |
0088 | End If |
0089 | End If |
0090 | 'Adjust for items that have missed the cut |
0091 | If str_Parameter_3_Local = "" Then |
0092 | strPara3 = "" |
0093 | Else |
0094 | If str_Parameter_3_Local = "1" Or str_Parameter_3_Local = "De-Duplicate" Then |
0095 | strPara3 = " AND ((PID_Note_Reading_Lists.[Missed_Cut?]) = False)" |
0096 | Else |
0097 | strPara3 = " AND ((PID_Note_Reading_Lists.[Missed_Cut?]) = True)" |
0098 | End If |
0099 | End If |
0100 | End If |
0101 | Select Case strParameter |
0102 | Case 1 |
0103 | strQuery = "Cross_Reference_By_Year" |
0104 | strElement = "However, there are (as of " & Now() & ", using +CFunctor_22C+ & query +QCross_Reference_By_YearQ+) the following counts of records on the table with timestamps in the years below:- " |
0105 | Case 2 |
0106 | strQuery = "Cross_Reference_Changes_By_Year" |
0107 | strElement = "" |
0108 | Case 3 |
0109 | DoCmd.OpenQuery ("Functor_Descriptions_GEN") |
0110 | strQuery = "Functor_Descriptions_List" |
0111 | strElement = "" |
0112 | Case 4 |
0113 | strQuery = "Cross_Reference_Changes_By_Month" |
0114 | strElement = "" |
0115 | Case 5 |
0116 | strQuery = "PID_Notes_Unused_By_Thesis" |
0117 | strElement = "" |
0118 | Case 6 |
0119 | strQuery = "SELECT PID_Note_Reading_Lists.[Book/Paper], PID_Note_Reading_Lists.Called_ID, PID_Note_Reading_Lists.Footnote, PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title, PID_Note_Reading_Lists.Item_Year, PID_Note_Reading_Lists.[Write-Up?], PID_Note_Reading_Lists.[Annotations?], PID_Note_Reading_Lists.[Abstract_Null?], PID_Note_Reading_Lists.[Link_External?], PID_Note_Reading_Lists.[Link_Internal?], PID_Note_Reading_Lists.[Percent_Read], PID_Note_Reading_Lists.[Reason_Missed_Cut] FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Read?]) = Yes) And ((PID_Note_Reading_Lists.[Suppress?]) = No)" & strPara2 & strPara3 & ") ORDER BY PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title;" |
0120 | strElement = "" |
0121 | Case 7 |
0122 | strQuery = "SELECT PID_Note_Reading_Lists.[Book/Paper], PID_Note_Reading_Lists.Called_ID, PID_Note_Reading_Lists.Footnote, PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title, PID_Note_Reading_Lists.Item_Year, PID_Note_Reading_Lists.[Write-Up?], PID_Note_Reading_Lists.[Annotations?], PID_Note_Reading_Lists.[Abstract_Null?], PID_Note_Reading_Lists.[Link_External?], PID_Note_Reading_Lists.[Link_Internal?], PID_Note_Reading_Lists.[Percent_Read], PID_Note_Reading_Lists.[Reason_Missed_Cut] FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Read?]) = No) And ((PID_Note_Reading_Lists.[Suppress?]) = No)" & strPara2 & strPara3 & ") ORDER BY PID_Note_Reading_Lists.Author, PID_Note_Reading_Lists.Title;" |
0123 | strElement = "" |
0124 | Case 8 |
0125 | If str_Parameter_2_Local = "" Then |
0126 | strQuery = "SELECT PID_Note_Reading_Lists.Category FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = Yes)) GROUP BY PID_Note_Reading_Lists.Category ORDER BY PID_Note_Reading_Lists.Category;" |
0127 | Else |
0128 | strQuery = "SELECT Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) AS Expr2 FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = Yes) And ((Left([Category], Len(""" & str_Parameter_2_Local & """))) = """ & str_Parameter_2_Local & """)) GROUP BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) ORDER BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1);" |
0129 | End If |
0130 | strElement = "" |
0131 | Case 9 |
0132 | If str_Parameter_2_Local = "" Then |
0133 | strQuery = "SELECT PID_Note_Reading_Lists.Category FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = No)) GROUP BY PID_Note_Reading_Lists.Category ORDER BY PID_Note_Reading_Lists.Category;" |
0134 | Else |
0135 | strQuery = "SELECT Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) AS Expr2 FROM PID_Note_Reading_Lists WHERE (((PID_Note_Reading_Lists.Note_ID) = " & Note_ID & ") And ((PID_Note_Reading_Lists.[Suppress?]) = No) " & strPara3 & " And ((PID_Note_Reading_Lists.[Read?]) = No) And ((Left([Category], Len(""" & str_Parameter_2_Local & """))) = """ & str_Parameter_2_Local & """)) GROUP BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1) ORDER BY Mid([Category],Len(""" & str_Parameter_2_Local & """)+1);" |
0136 | End If |
0137 | strElement = "" |
0138 | Case 10 |
0139 | If str_Parameter_2_Local = "Read" Then |
0140 | strPara2 = "((Functor_Usage.Functor_Option)=6 Or (Functor_Usage.Functor_Option)=8) " |
0141 | Else |
0142 | strPara2 = "((Functor_Usage.Functor_Option)=7 Or (Functor_Usage.Functor_Option)=9) " |
0143 | End If |
0144 | strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Thesis_Note_XRef.PID_Note_ID, Thesis_Note_XRef.PID_Note_Caption, Functor_Usage.Functor_Option, Functor_Usage.Functor_Parameter FROM Thesis_Note_XRef INNER JOIN Functor_Usage ON Thesis_Note_XRef.PID_Note_ID = Functor_Usage.Note_ID WHERE (" & strPara2 & " And ((Functor_Usage.Functor_ID) = 22) And ((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_ID & ") And ((Thesis_Note_XRef.[Exclude?]) = No)) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Thesis_Note_XRef.PID_Note_Caption;" |
0145 | OK = Update_Thesis_Chapter_RLs(Note_ID) |
0146 | strElement = "" |
0147 | Case 11 |
0148 | strQuery = "PID_Notes_Unused_By_Thesis_Note_Lists" |
0149 | strElement = "" |
0150 | Case 12 |
0151 | strQuery = "PDF_File_List" |
0152 | strElement = "" |
0153 | Case 13 |
0154 | strQuery = "Thesis_Reading_List" |
0155 | strElement = "" |
0156 | Case 14 |
0157 | Select Case str_Parameter_2_Local |
0158 | Case "1" |
0159 | strQuery = "SELECT * FROM Thesis_Reading_List_Cited;" |
0160 | Case "2" |
0161 | strQuery = "SELECT * FROM Thesis_Reading_List_Cited_Note WHERE Note_ID = " & Note_ID & " ORDER BY Author, Title;" |
0162 | End Select |
0163 | strElement = "" |
0164 | End Select |
0165 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0166 | strList_Local = "" |
0167 | If rs.EOF Then |
0168 | Set rs = Nothing |
0169 | Debug.Print Now(); "- Functor_22: Option " & strParameter & " (Note = " & Note_ID & ") - No list to print" |
0170 | If strParameter = 6 Or strParameter = 7 Then |
0171 | strElement = "|ii|" |
0172 | strElement = strElement & "|1|No items to list. " |
0173 | strElement = strElement & "|ii|" |
0174 | Functor_22 = "Yes" |
0175 | strList = strElement |
0176 | Else |
0177 | If ((strParameter = 8 Or strParameter = 9) And str_Parameter_3_Local = "2") Or (strParameter = 14 And str_Parameter_2_Local = "2") Then |
0178 | Functor_22 = "Yes" |
0179 | strElement = strElement & "No items to list. " |
0180 | strList_Local = strList_Local & strElement |
0181 | strList = strList_Local |
0182 | Else |
0183 | Functor_22 = "No" |
0184 | End If |
0185 | End If |
0186 | Exit Function |
0187 | Else |
0188 | rs.MoveFirst |
0189 | End If |
0190 | 'Set up List Header |
0191 | Select Case strParameter |
0192 | Case 6, 7 |
0193 | strElement = strElement & "|ii|" |
0194 | Case 10 |
0195 | strElement = "|II|" |
0196 | Field_3 = "" |
0197 | Field_4 = "" |
0198 | Case 3, 8, 9, 12 |
0199 | strElement = "|##|" |
0200 | Case Else |
0201 | strElement = strElement & "|99|" |
0202 | End Select |
0203 | strList_Local = strList_Local & strElement |
0204 | strElement = "" |
0205 | Do Until rs.EOF |
0206 | Field_2 = "" |
0207 | Select Case strParameter |
0208 | Case 5, 11 |
0209 | strElement = strElement & "|.|" |
0210 | strElement = strElement & rs.Fields(0) |
0211 | Case 6, 7, 13, 14 |
0212 | strElement = strElement & "|1|" |
0213 | BP = Left(rs.Fields(0), 1) |
0214 | strElement = strElement & "+" & BP & rs.Fields(1) & BP & "+" |
0215 | Item_Year = rs.Fields(5) & "" |
0216 | If Item_Year <> "" Then |
0217 | strElement = strElement & ", " & Item_Year |
0218 | End If |
0219 | If BP = "B" Then |
0220 | strElement = strElement & ", " & "Book" |
0221 | End If |
0222 | Write_Up_Note = rs.Fields(6) |
0223 | If Write_Up_Note > 0 Then |
0224 | strElement = strElement & ", [Write-Up Note]++" & Write_Up_Note & "++" |
0225 | End If |
0226 | If rs.Fields(7) = True Then |
0227 | strElement = strElement & ", Annotations" |
0228 | End If |
0229 | If rs.Fields(8) = True And Write_Up_Note = 0 Then |
0230 | strElement = strElement & ", No Abstract" |
0231 | End If |
0232 | If rs.Fields(9) = True Then |
0233 | strElement = strElement & ", External Link" |
0234 | End If |
0235 | If rs.Fields(10) = True Then |
0236 | strElement = strElement & ", Internal PDF Link" |
0237 | End If |
0238 | If strParameter = 7 And rs.Fields(11) > 0 Then |
0239 | strElement = strElement & ", Read = " & rs.Fields(11) & "%" |
0240 | End If |
0241 | If strParameter = 13 Or strParameter = 14 Then |
0242 | If rs.Fields(12) = True Then |
0243 | strElement = strElement & ", Read" |
0244 | Else |
0245 | If rs.Fields(11) > 0 Then |
0246 | strElement = strElement & ", Read = " & rs.Fields(11) & "%" |
0247 | End If |
0248 | End If |
0249 | End If |
0250 | FN = rs.Fields(2) & "" |
0251 | If FN <> "" Then |
0252 | If (Len(FN) < 31) And InStr(FN, "|") = 0 And InStr(FN, "+") = 0 Then 'Allow for quick comment / characterisation, eg. "Aeon" or "August 2019" |
0253 | strElement = strElement & ", Note: " & FN |
0254 | Else |
0255 | If InStr(FN, "|") = 0 Then |
0256 | FN = "|..||.|" & FN & "|..|" |
0257 | End If |
0258 | strElement = strElement & ", Footnote++FN" & FN & "++" |
0259 | End If |
0260 | End If |
0261 | If str_Parameter_3_Local = "2" Then |
0262 | If rs.Fields(12) & "" <> "" Then |
0263 | strElement = strElement & ", Missed Cut: " & rs.Fields(12) |
0264 | End If |
0265 | End If |
0266 | Case 8, 9 |
0267 | strElement = strElement & "|.|" |
0268 | strElement = strElement & "" & IIf(rs.Fields(0) & "" = "", "General", rs.Fields(0)) & ": " |
0269 | OK = Functor_22(IIf(strParameter = 8, 6, 7), strCell, Note_ID, str_Parameter_2_Local & rs.Fields(0), str_Parameter_3_Local, str_Parameter_4_Local) |
0270 | strElement = strElement & strCell |
0271 | Case 10 |
0272 | If rs.Fields(3) & "" <> Field_4 Then |
0273 | If Field_4 <> "" Then |
0274 | Field_2 = Field_2 & "|oo|" |
0275 | End If |
0276 | If rs.Fields(3) & "" <> "" Then |
0277 | Field_2 = Field_2 & "|1|" & rs.Fields(3) |
0278 | End If |
0279 | Field_4 = rs.Fields(3) & "" |
0280 | If Field_4 <> "" Then |
0281 | Field_2 = Field_2 & "|oo|" |
0282 | End If |
0283 | End If |
0284 | If rs.Fields(2) & "" <> Field_3 Then |
0285 | If Field_3 <> "" Then |
0286 | Field_2 = Field_2 & "|AA|" |
0287 | End If |
0288 | If rs.Fields(2) & "" <> "" Then |
0289 | Field_2 = Field_2 & "|1|" & rs.Fields(2) & "|AA|" |
0290 | End If |
0291 | Field_3 = rs.Fields(2) & "" |
0292 | End If |
0293 | Field_1 = rs.Fields(5) |
0294 | Select Case Field_1 |
0295 | Case "1" |
0296 | Field_2 = Field_2 & "|1|" |
0297 | Case "2" |
0298 | Field_2 = Field_2 & "|1|" |
0299 | Case "3" |
0300 | Field_2 = Field_2 & "|.|" |
0301 | End Select |
0302 | Field_2 = Field_2 & "[" & rs.Fields(7) & "]++" & rs.Fields(6) & "++" |
0303 | strElement = strElement & Field_2 |
0304 | OK = Functor_22(rs.Fields(8), strCell, rs.Fields(6), rs.Fields(9) & "", "De-Duplicate", rs.Fields(0)) |
0305 | strElement = strElement & strCell |
0306 | Case 12 |
0307 | strElement = strElement & Chr$(10) |
0308 | strElement = strElement & "|.|" & "" & "" & rs.Fields(1) & ".pdf " & rs.Fields(0) |
0309 | Case Else |
0310 | strElement = strElement & "|.|" |
0311 | strElement = strElement & "" & rs.Fields(0) & ": " |
0312 | strCell = rs.Fields(1) |
0313 | OK = Number_Format(strCell) |
0314 | strElement = strElement & strCell |
0315 | End Select |
0316 | rs.MoveNext |
0317 | Loop |
0318 | strList_Local = strList_Local & strElement |
0319 | 'Set up End List |
0320 | Select Case strParameter |
0321 | Case 6, 7 |
0322 | strElement = "|ii|" |
0323 | Case 10 |
0324 | strElement = "" |
0325 | If Field_4 <> "" Then |
0326 | strElement = strElement & "|oo|" |
0327 | End If |
0328 | If Field_3 <> "" Then |
0329 | strElement = strElement & "|AA|" |
0330 | End If |
0331 | strElement = strElement & "|II|" |
0332 | Case 13, 14 |
0333 | strElement = "|99|" |
0334 | Case Else |
0335 | strElement = "|##|" |
0336 | End Select |
0337 | strList_Local = strList_Local & strElement |
0338 | Functor_22 = "Yes" |
0339 | strList = strList_Local |
0340 | Set rs = Nothing |
0341 | End Function |
Procedures Calling This Procedure (Functor_22)
Procedures Called By This Procedure (Functor_22)
Tables / Queries / Fragments Directly Used By This Procedure (Functor_22)
- Cross_Reference_By_Year (Query, used in Line 103)
- Cross_Reference_Changes_By_Month (Query, used in Line 113)
- Cross_Reference_Changes_By_Year (Query, used in Line 106)
- Functor_Descriptions_GEN (Query, used in Line 109)
- Functor_Descriptions_List (Query, used in Line 110)
- Functor_Usage (Table, used in Lines 140, 142)
- IdentityBooks_Unreferenced_Gen (Query, used in Line 52)
- IdentityPapersRead_Unreferenced_Gen (Query, used in Line 53)
- PDF_File_List (Query, used in Line 151)
- PID_Note_Reading_Lists (Table, used in Lines 55, 58, 61, 73, 85, 87, 95, 97, 119, 122, 126, 128, 133, 135)
- PID_Note_Reading_Lists_Books_Chk (Query, used in Lines 39, 41)
- PID_Note_Reading_Lists_Papers_Chk (Query, used in Lines 44, 46)
- PID_Notes_Books_Referenced_Gen (Query, used in Line 50)
- PID_Notes_Papers_Referenced_Gen (Query, used in Line 51)
- PID_Notes_Unused_By_Thesis (Query, used in Line 116)
- PID_Notes_Unused_By_Thesis_Note_Lists (Query, used in Line 148)
- Thesis_Chapters (Query, used in Line 67)
- Thesis_Note_XRef (Table, used in Line 144)
- Thesis_Reading_List (Query, used in Line 154)
- Thesis_Reading_List_Cited (Query, used in Line 159)
- Thesis_Reading_List_Cited_Note (Query, used in Line 161)
Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page
Source Code of: Functor_23 Procedure Type: Public Function Module: Functors Lines of Code: 296
Go To End of This Procedure
Line-No. / Ref. | Code Line |
0001 | Public Function Functor_23(Note_ID, strOption, strValue, Optional str_Parameter_2) |
0002 | 'For this function:- |
0003 | ' ... Options 1-14 & 21-23 return a value (together with surrounding narrative) from a query |
0004 | ' ... Options 15-19 produce an indented list from a query |
0005 | ' ... Option 20 produces the table for the Thesis Dashboard |
0006 | Dim rs As Recordset |
0007 | Dim strValue_Local As String |
0008 | Dim strElement As String |
0009 | Dim strMsg As String |
0010 | Dim strQuery As String |
0011 | Dim Field_1 As String |
0012 | Dim Field_2 As String |
0013 | Dim Field_3 As String |
0014 | Dim i As Integer |
0015 | Dim j As Integer |
0016 | Dim str_Parameter_2_Local As String |
0017 | Dim strPara2 As String |
0018 | If IsMissing(str_Parameter_2) Then |
0019 | str_Parameter_2_Local = "" |
0020 | Else |
0021 | str_Parameter_2_Local = str_Parameter_2 |
0022 | End If |
0023 | Select Case strOption |
0024 | Case "1" |
0025 | strQuery = "Dud_Cross_References_This_Year" |
0026 | Case "2" |
0027 | strQuery = "Cross_Reference_MaxID" |
0028 | Case "3" |
0029 | strQuery = "SELECT Count(Cross_Reference_Changes.ID) AS CountOfID FROM Cross_Reference_Changes;" |
0030 | Case "4" |
0031 | strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Paper_Abstract_Ranges""));" |
0032 | Case "5" |
0033 | strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Author_Letters""));" |
0034 | Case "6" |
0035 | strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""BookPaperAbstract_Ranges""));" |
0036 | Case "7" |
0037 | strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Note_Regen_Ranges""));" |
0038 | Case "8" |
0039 | strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Note_Archive_Regen_Ranges""));" |
0040 | Case "9" |
0041 | strQuery = "SELECT * FROM Oboe_Latest_Lesson;" |
0042 | Case "10" |
0043 | strQuery = "SELECT BookPaperControl.Time_To_Regenerate, BookPaperControl.Latest_Update FROM BookPaperControl WHERE (((BookPaperControl.[ID])=""Auto_Reference_Notes_Regen""));" |
0044 | Case "11" |
0045 | strQuery = "Hits_Pages_Totals" |
0046 | Case "12" |
0047 | strQuery = "Hits_Pages_Totals_LastYear" |
0048 | Case "13" |
0049 | strQuery = "SELECT Count(Site_Map.Size) AS Records, Max([Timestamp_Logged]) AS [As At] FROM Site_Map;" |
0050 | Case "14" |
0051 | strQuery = "SELECT Website_Regen_Control.Regen_Mins, Website_Regen_Control.Last_Run, Website_Regen_Control.Division FROM Website_Regen_Control WHERE (((Website_Regen_Control.Division)=""Book_Summary_Ranges""));" |
0052 | Case "15" |
0053 | Select Case str_Parameter_2_Local |
0054 | Case "1" |
0055 | strQuery = "Earliest_Lang_Dates" |
0056 | Case "2" |
0057 | strQuery = "Ling_Progress" |
0058 | End Select |
0059 | Case "16", "18" |
0060 | strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title, Thesis_Note_XRef.PID_Note_ID, Thesis_Note_XRef.PID_Note_Caption, Thesis_Note_XRef.PID_Footnote, Thesis_Note_XRef.[Exclude?], Thesis_Note_XRef.Reason_Excluded FROM Thesis_Note_XRef INNER JOIN Notes ON Thesis_Note_XRef.PID_Note_ID = Notes.ID WHERE (((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_ID & ")) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title;" |
0061 | Case "17", "19" |
0062 | If str_Parameter_2_Local = "Read" Then |
0063 | strPara2 = "((Functor_Usage.Functor_Option)=6 Or (Functor_Usage.Functor_Option)=8) " |
0064 | Else |
0065 | strPara2 = "((Functor_Usage.Functor_Option)=7 Or (Functor_Usage.Functor_Option)=9) " |
0066 | End If |
0067 | strQuery = "SELECT Thesis_Note_XRef.Thesis_Chapter_Note_ID, Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Notes.Item_Title, Thesis_Note_XRef.PID_Note_ID, Thesis_Note_XRef.PID_Note_Caption, Functor_Usage.Functor_Option, Functor_Usage.Functor_Parameter FROM (Thesis_Note_XRef INNER JOIN Functor_Usage ON Thesis_Note_XRef.PID_Note_ID = Functor_Usage.Note_ID) INNER JOIN Notes ON Thesis_Note_XRef.PID_Note_ID = Notes.ID WHERE (" & strPara2 & " And ((Thesis_Note_XRef.Thesis_Chapter_Note_ID) = " & Note_ID & ") And ((Functor_Usage.Functor_ID) = 22) And ((Thesis_Note_XRef.[Exclude?]) = No)) ORDER BY Thesis_Note_XRef.PID_Note_Seq, Thesis_Note_XRef.PID_Note_Category_1, Thesis_Note_XRef.PID_Note_Category_2, Thesis_Note_XRef.PID_Note_Category_3, Thesis_Note_XRef.PID_Note_Level, Thesis_Note_XRef.PID_Note_Caption;" |
0068 | Case "20" |
0069 | strQuery = "Thesis_Progress_Dashboard_List" |
0070 | Case "21" |
0071 | Select Case str_Parameter_2_Local |
0072 | Case "1" |
0073 | strQuery = "PID_Notes_Unused_By_Thesis_Count" |
0074 | Case "2" |
0075 | strQuery = "PID_Notes_Unused_By_Thesis_Note_Lists_Count" |
0076 | Case "3" |
0077 | strQuery = "IdentityBooks_Unreferenced_Count" |
0078 | Case "4" |
0079 | strQuery = "IdentityPapersRead_Unreferenced_Count" |
0080 | Case "5" |
0081 | strQuery = "Works_Missing_By_Thesis_Chapter_Count" |
0082 | Case "6" |
0083 | strQuery = "PID_Papers_Filed_Not_Referenced_Count" |
0084 | Case "7" |
0085 | strQuery = "PID_Papers_Referenced_Undated_Count" |
0086 | Case "8" |
0087 | strQuery = "PID_Papers_Referenced_No_Abstract_Count" |
0088 | Case "9" |
0089 | strQuery = "Large_Page_List_Count" |
0090 | Case "10" |
0091 | strQuery = "PDF_Missing_List_Count" |
0092 | Case "11" |
0093 | strQuery = "Duplicate_Papers_Count" |
0094 | Case "12" |
0095 | strQuery = "PDF_File_List_Count" |
0096 | Case "13" |
0097 | strQuery = "Missing_Webref_DisplayText_List_Count" |
0098 | Case "14" |
0099 | strQuery = "PID_Missing_Online_Papers_List_Count" |
0100 | Case "15" |
0101 | strQuery = "Missing_Webref_DisplayText_List_Books_Count" |
0102 | Case "16" |
0103 | strQuery = "Papers_Inconsistently_Electronic_Count" |
0104 | Case "17" |
0105 | strQuery = "Thesis_Reading_List_Count" |
0106 | Case "18" |
0107 | strQuery = "Thesis_Reading_List_Cited_Count" |
0108 | End Select |
0109 | Case "22" |
0110 | strQuery = "SELECT PID_Missing_Online_Papers_List.[PID Note], Sum(1) AS Total, Sum(IIf([Accept?]=""Yes"",1,0)) AS Accepted, Sum(IIf([Pending?]=""Yes"",1,0)) AS Pending, Sum(IIf([Reserve?]=""Yes"",1,0)) AS Reserve FROM PID_Missing_Online_Papers_List WHERE (((PID_Missing_Online_Papers_List.[PID Note]) Like ""*+" & Note_ID & "+*"")) GROUP BY PID_Missing_Online_Papers_List.[PID Note];" |
0111 | Case "23" |
0112 | Select Case str_Parameter_2_Local |
0113 | Case "1" |
0114 | strQuery = "PID_Pages_Total" |
0115 | Case "2" |
0116 | strQuery = "Paper_Pages_Total" |
0117 | End Select |
0118 | Case Else |
0119 | Debug.Print Now(); "- Note: " & Note_ID & ". Functor_23 : Invalid Option : " & strOption |
0120 | Functor_23 = "No" |
0121 | Exit Function |
0122 | End Select |
0123 | If strOption <> "20" Then |
0124 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0125 | strValue_Local = "" |
0126 | If rs.EOF Then |
0127 | Debug.Print Now(); "- Note: " & Note_ID & ". Functor_23 : No item to print (Option = " & strOption & ")" |
0128 | Functor_23 = "No" |
0129 | Exit Function |
0130 | End If |
0131 | End If |
0132 | Select Case strOption |
0133 | Case "1" |
0134 | rs.MoveLast |
0135 | strElement = rs.Fields(1) |
0136 | If rs.Fields(0) <> rs.Fields(2) Then |
0137 | strElement = 0 |
0138 | End If |
0139 | If strElement = 0 Then |
0140 | strElement = "no" |
0141 | strMsg = "encouraging." |
0142 | Else |
0143 | strMsg = "worrying. Investigate!" |
0144 | Debug.Print Now(); "Note: " & Note_ID & ". Functor_23, Option 1 : Non-zero value printed - Investigate!" |
0145 | End If |
0146 | strValue_Local = strElement & " record" & IIf(Val(strElement) > 1, "s", "") & " for " & rs.Fields(2) & " prior to the " & rs.Fields(3) & " regeneration, which is " & strMsg |
0147 | Case "2" |
0148 | rs.MoveFirst |
0149 | strElement = rs.Fields(0) |
0150 | OK = Number_Format(strElement) |
0151 | strValue_Local = Now() & " it is " & strElement & " - but it's taken " & Year(Now) - 2015 |
0152 | Case "3" |
0153 | rs.MoveFirst |
0154 | strElement = rs.Fields(0) |
0155 | OK = Number_Format(strElement) |
0156 | strValue_Local = strElement & " rows, as of " & Left(Now(), 10) & ", " |
0157 | Case "4", "5", "6", "7", "8", "10", "14" |
0158 | rs.MoveFirst |
0159 | strElement = rs.Fields(0) |
0160 | If strElement >= 60 Then |
0161 | strElement = Round(strElement / 60, 2) & " hours" |
0162 | Else |
0163 | strElement = strElement & " minutes" |
0164 | End If |
0165 | strElement = strElement & " on " & Left(rs.Fields(1), 10) |
0166 | strValue_Local = strElement |
0167 | Case "9" |
0168 | rs.MoveFirst |
0169 | strValue_Local = rs.Fields(0) & "" |
0170 | Case "11", "12" |
0171 | rs.MoveFirst |
0172 | Field_1 = Nz(rs.Fields(0), 0) 'Min period recorded |
0173 | Field_2 = Nz(rs.Fields(1), 0) 'Max period recorded |
0174 | Field_3 = Nz(rs.Fields(2), 0) 'Total Hits |
0175 | Field_1 = Left(Field_1, 4) * 12 + Right(Field_1, 2) |
0176 | Field_2 = Left(Field_2, 4) * 12 + Right(Field_2, 2) |
0177 | Field_1 = Field_2 - Field_1 + 1 |
0178 | Field_2 = Field_1 * 365 / 12 |
0179 | Field_3 = Round(Field_3 / Field_2 / 1000, 1) |
0180 | strValue_Local = Field_3 & "k or so hits a day over the " & Field_1 & " months up to " & rs.Fields(1) |
0181 | Case "13" |
0182 | rs.MoveFirst |
0183 | strValue_Local = Round(rs.Fields(0) / 1000, 0) & "k pages on my site as at " & Left(rs.Fields(1), 10) |
0184 | Case "15" |
0185 | rs.MoveFirst |
0186 | Select Case str_Parameter_2_Local |
0187 | Case "1" |
0188 | strValue_Local = "The next languages in the queue are:- |..|" |
0189 | Field_3 = "" |
0190 | Case "2" |
0191 | strValue_Local = "Progress on Ling (in progress order):- |..|" |
0192 | Field_2 = "" |
0193 | End Select |
0194 | Do Until rs.EOF |
0195 | Select Case str_Parameter_2_Local |
0196 | Case "1" |
0197 | Field_1 = rs.Fields(0) & rs.Fields(1) |
0198 | Field_2 = rs.Fields(2) |
0199 | If Field_2 = "0" Then |
0200 | Field_2 = "Not yet studied" |
0201 | Else |
0202 | Field_2 = "Last studied on " & Format(Field_2, "Long Date") |
0203 | If rs.Fields(4) & "" > "0" Then |
0204 | Field_2 = Field_2 & "; Last Ling Lesson = " & rs.Fields(4) |
0205 | End If |
0206 | If rs.Fields(5) & "" <> "" Then |
0207 | Field_2 = Field_2 & "; Last Ling Revision = " & rs.Fields(5) |
0208 | End If |
0209 | End If |
0210 | If Field_3 <> Field_1 Then |
0211 | If Field_3 <> "" Then |
0212 | strValue_Local = strValue_Local & "|99|" |
0213 | End If |
0214 | strValue_Local = strValue_Local & "|.|" & rs.Fields(0) & ": Priority " & rs.Fields(1) & ": |99|" |
0215 | End If |
0216 | strValue_Local = strValue_Local & "|1|" & Replace(rs.Fields(3), " (Modern)", "") & ". " & Field_2 |
0217 | Field_3 = Field_1 |
0218 | Case "2" |
0219 | Field_1 = rs.Fields(0) |
0220 | If Field_2 <> Field_1 Then |
0221 | If Field_2 <> "" Then |
0222 | strValue_Local = strValue_Local & "|99|" |
0223 | End If |
0224 | strValue_Local = strValue_Local & "|.|Priority " & Field_1 & ":- |99|" |
0225 | End If |
0226 | strValue_Local = strValue_Local & "|1|" & rs.Fields(2) & ": " & rs.Fields(1) & IIf(rs.Fields(3) & "" <> "", " (Revision: " & rs.Fields(3) & ")", "") |
0227 | Field_2 = Field_1 |
0228 | End Select |
0229 | rs.MoveNext |
0230 | Loop |
0231 | strValue_Local = strValue_Local & "|99||..|" |
0232 | Case "16" |
0233 | OK = Functor_Indented_List(rs, strValue_Local) |
0234 | Case "17" |
0235 | OK = Update_Thesis_Chapter_RLs(Note_ID) |
0236 | OK = Functor_Indented_List(rs, strValue_Local, True) |
0237 | Case "18" 'Test only |
0238 | OK = Functor_Indented_List_Development(rs, strValue_Local) |
0239 | Case "19" |
0240 | OK = Update_Thesis_Chapter_RLs(Note_ID) |
0241 | OK = Functor_Indented_List_Development(rs, strValue_Local, True) |
0242 | Case "20" |
0243 | OK = Thesis_Dashboard_Table_Gen(strValue_Local, strQuery) |
0244 | Case "21" |
0245 | rs.MoveFirst |
0246 | strElement = rs.Fields(0) |
0247 | If str_Parameter_2_Local = "6" Then |
0248 | Field_1 = Nz(rs.Fields(1)) |
0249 | End If |
0250 | OK = Number_Format(strElement) |
0251 | strValue_Local = "(" & strElement & " item" & IIf(strElement = 1, "", "s") & IIf(str_Parameter_2_Local = "6", ", " & Field_1 & " unactioned", "") & ")" |
0252 | If str_Parameter_2_Local = "17" Or str_Parameter_2_Local = "18" Then |
0253 | strValue_Local = Replace(strValue_Local, "(", "") |
0254 | strValue_Local = Replace(strValue_Local, ")", "") |
0255 | End If |
0256 | Case "22" |
0257 | If rs.EOF Then |
0258 | strValue_Local = "" |
0259 | Else |
0260 | strValue_Local = "|.|" |
0261 | Field_1 = rs.Fields(0) |
0262 | Field_1 = Mid(Field_1, 2, InStr(Field_1, "]") - 2) |
0263 | Field_1 = Replace(Field_1, " ", "") |
0264 | 'Field_1 = "PDFs_" & Field_1 |
0265 | Field_1 = Left("PDFs_" & Field_1, 20) |
0266 | Field_1 = "For further papers held on-line of potential interest, follow this Link++1317#" & Field_1 & "++." |
0267 | i = rs.Fields.Count |
0268 | Field_1 = Field_1 & " Total papers = " & rs.Fields(1) |
0269 | If i > 2 Then |
0270 | Field_1 = Field_1 |
0271 | Field_3 = ". Including " |
0272 | j = 2 |
0273 | Field_2 = "" |
0274 | Do Until j > i - 1 |
0275 | If rs.Fields(j) > 0 Then |
0276 | Field_1 = Field_1 & Field_3 & Field_2 & rs.Fields(j).Name & " = " & rs.Fields(j) |
0277 | Field_2 = ", " |
0278 | Field_3 = "" |
0279 | End If |
0280 | j = j + 1 |
0281 | Loop |
0282 | Field_1 = Field_1 & "." |
0283 | End If |
0284 | strValue_Local = strValue_Local & Field_1 |
0285 | End If |
0286 | Case "23" |
0287 | rs.MoveFirst |
0288 | strElement = rs.Fields(0) |
0289 | strElement = Round(strElement / 1000, 0) |
0290 | OK = Number_Format(strElement) |
0291 | strValue_Local = strElement & "k pages, as at " & Now() |
0292 | End Select |
0293 | Functor_23 = "Yes" |
0294 | strValue = Trim(strValue_Local) |
0295 | Set rs = Nothing |
0296 | End Function |
Procedures Calling This Procedure (Functor_23)
Procedures Called By This Procedure (Functor_23)
Tables / Queries / Fragments Directly Used By This Procedure (Functor_23)
- BookPaperAbstract_Ranges (Table, used in Line 35)
- BookPaperControl (Table, used in Line 43)
- Cross_Reference_Changes (Table, used in Line 29)
- Cross_Reference_MaxID (Query, used in Line 27)
- Dud_Cross_References_This_Year (Query, used in Line 25)
- Duplicate_Papers_Count (Query, used in Line 93)
- Earliest_Lang_Dates (Query, used in Line 55)
- Functor_Usage (Table, used in Lines 63, 65)
- Hits_Pages_Totals (Query, used in Line 45)
- Hits_Pages_Totals_LastYear (Query, used in Line 47)
- IdentityBooks_Unreferenced_Count (Query, used in Line 77)
- IdentityPapersRead_Unreferenced_Count (Query, used in Line 79)
- Large_Page_List_Count (Query, used in Line 89)
- Ling_Progress (Query, used in Line 57)
- Missing_Webref_DisplayText_List_Books_Count (Query, used in Line 101)
- Missing_Webref_DisplayText_List_Count (Query, used in Line 97)
- Note_Archive_Regen_Ranges (Table, used in Line 39)
- Oboe_Latest_Lesson (Table, used in Line 41)
- Paper_Abstract_Ranges (Table, used in Line 31)
- Paper_Pages_Total (Query, used in Line 116)
- Papers (Table, used in Lines 266, 268)
- Papers_Inconsistently_Electronic_Count (Query, used in Line 103)
- PDF_File_List_Count (Query, used in Line 95)
- PDF_Missing_List_Count (Query, used in Line 91)
- PID_Missing_Online_Papers_List (Query, used in Line 110)
- PID_Missing_Online_Papers_List_Count (Query, used in Line 99)
- PID_Notes_Unused_By_Thesis_Count (Query, used in Line 73)
- PID_Notes_Unused_By_Thesis_Note_Lists_Count (Query, used in Line 75)
- PID_Pages_Total (Query, used in Line 114)
- PID_Papers_Filed_Not_Referenced_Count (Query, used in Line 83)
- PID_Papers_Referenced_No_Abstract_Count (Query, used in Line 87)
- PID_Papers_Referenced_Undated_Count (Query, used in Line 85)
- Site_Map (Table, used in Line 49)
- Thesis_Note_XRef (Table, used in Lines 60, 67)
- Thesis_Progress_Dashboard_List (Query, used in Line 69)
- Thesis_Reading_List_Cited_Count (Query, used in Line 107)
- Thesis_Reading_List_Count (Query, used in Line 105)
- Website_Regen_Control (Table, used in Lines 33, 37, 51)
- Works_Missing_By_Thesis_Chapter_Count (Query, used in Line 81)
Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page
Source Code of: Jacks_Non_Prime Procedure Type: Public Sub Module: Testing Lines of Code: 36
Go To End of This Procedure
Line-No. / Ref. | Code Line |
0001 | Public Sub Jacks_Non_Prime() |
0002 | 'Prove that 2^10 + 5^12 is non-prime |
0003 | 'The program shows:- |
0004 | '... The number is 244,141,649 = 14657 x 16657 |
0005 | '... Max Long is 2,147,483,647, so didn't need LongLong |
0006 | Dim Non_Prime As LongLong |
0007 | Dim Non_Prime_Temp As LongLong |
0008 | Dim Non_Prime_Sqrt As Integer |
0009 | Dim i As Integer |
0010 | Non_Prime_Temp = 1 |
0011 | For i = 1 To 10 |
0012 | Non_Prime_Temp = Non_Prime_Temp * 2 |
0013 | Next i |
0014 | Debug.Print Non_Prime_Temp |
0015 | Non_Prime = Non_Prime_Temp |
0016 | Non_Prime_Temp = 1 |
0017 | For i = 1 To 12 |
0018 | Non_Prime_Temp = Non_Prime_Temp * 5 |
0019 | Next i |
0020 | Debug.Print Non_Prime_Temp |
0021 | Non_Prime = Non_Prime + Non_Prime_Temp |
0022 | Debug.Print Non_Prime |
0023 | Non_Prime_Sqrt = Non_Prime ^ 0.5 |
0024 | Debug.Print Non_Prime_Sqrt |
0025 | Non_Prime_Sqrt = Non_Prime_Sqrt / 2 + 1 |
0026 | For i = 1 To Non_Prime_Sqrt |
0027 | Non_Prime_Temp = Non_Prime Mod (2 * i + 1) |
0028 | If Non_Prime_Temp = 0 Then |
0029 | Debug.Print 2 * i + 1 |
0030 | Non_Prime_Temp = Non_Prime / (2 * i + 1) |
0031 | Debug.Print Non_Prime_Temp |
0032 | Non_Prime_Temp = Non_Prime_Temp * (2 * i + 1) |
0033 | Debug.Print Non_Prime_Temp |
0034 | End If |
0035 | Next i |
0036 | End Sub |
Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page
Source Code of: Number_Format Procedure Type: Public Function Module: New Code Lines of Code: 42
Go To End of This Procedure
Line-No. / Ref. | Code Line |
0001 | Public Function Number_Format(strNumber_Sent) |
0002 | Dim strNumber_Local As String |
0003 | Dim Digit_Table(20) As String |
0004 | Dim i As Integer |
0005 | Dim j As Integer |
0006 | Dim iLen_Number As Integer |
0007 | 'This function inserts commas into a number sent ... |
0008 | 'I may get it to do further functions in due course |
0009 | ' .... I couldn't find an HTML format command to do this |
0010 | ' .... but there must be a VBA built-in function? |
0011 | strNumber_Local = Trim(strNumber_Sent) |
0012 | If Not IsNumeric(strNumber_Local) Then |
0013 | Exit Function |
0014 | End If |
0015 | If Val(strNumber_Local) < 1000 Then 'Can't be any commas |
0016 | Exit Function |
0017 | End If |
0018 | iLen_Number = Len(strNumber_Local) |
0019 | For i = 1 To 20 |
0020 | Digit_Table(i) = "" |
0021 | Next i |
0022 | 'Add the commas (in reverse) |
0023 | j = 1 |
0024 | For i = 1 To iLen_Number |
0025 | Digit_Table(j) = Mid(strNumber_Local, iLen_Number + 1 - i, 1) |
0026 | j = j + 1 |
0027 | If i Mod 3 = 0 Then |
0028 | Digit_Table(j) = "," |
0029 | j = j + 1 |
0030 | End If |
0031 | Next i |
0032 | 'Remove trailing comma |
0033 | If Digit_Table(j - 1) = "," Then |
0034 | Digit_Table(j - 1) = "" |
0035 | End If |
0036 | strNumber_Local = "" |
0037 | For i = 1 To j - 1 |
0038 | strNumber_Local = strNumber_Local & Digit_Table(j - i) |
0039 | Next i |
0040 | 'Exit |
0041 | strNumber_Sent = strNumber_Local |
0042 | End Function |
Procedures Calling This Procedure (Number_Format)
Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page
| | | | | | | | | | |