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 54 (10 items)

Check_DelimitersFunctor_06Language_Animadversion_TranslateLink_Narr_Gen
Oboe_File_Links_ListPaperSumaryAbstract_LinksSpot_Invalid_CognatesSubject_Hours_List
Find_FunctorsKaprekar_Main..

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

Go to top of page



Source Code of: Check_Delimiters
Procedure Type: Public Function
Module: Testing
Lines of Code: 31
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Check_Delimiters(strText, strDelimeter)
0002Dim strText_Local As String
0003Dim strText_Undelimited As String
0004Dim i As Long
0005Dim j As Long
0006Dim k As Long
0007Dim strMsg As String
0008strText_Local = strText
0009strText_Undelimited = Replace(strText_Local, strDelimeter, "", 1, -1, vbBinaryCompare)
0010i = Len(strText_Local)
0011j = Len(strText_Undelimited)
0012k = (i - j) / Len(strDelimeter)
0013j = k Mod 2
0014If j <> 0 Then
0015 i = InStr(1, strText_Local, strDelimeter, vbBinaryCompare)
0016 If i > 100 Then
0017 strMsg = Mid(strText_Local, i - 100, 500)
0018 Else
0019 strMsg = Mid(strText_Local, 1, 500)
0020 End If
0021 strMsg = Now() & " - Unpaired Delimeters - " & strDelimeter & " (Count = " & k & ") in text segment commencing ... " & strMsg
0022 Debug.Print strMsg
0023 If (automatic_processing <> "Yes") And (automatic_processing <> "Full") Then
0024 MsgBox strMsg
0025 Stop
0026 End If
0027 Check_Delimiters = "Unpaired Delimeters"
0028Else
0029 Check_Delimiters = "OK"
0030End If
0031End Function

Procedures Calling This Procedure (Check_Delimiters) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Find_Functors
Procedure Type: Public Sub
Module: Functors
Lines of Code: 88
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Find_Functors()
0002Dim rs_In As Recordset
0003Dim rs_Out As Recordset
0004Dim rs_Test As Recordset
0005Dim strQuery As String
0006Dim strNote_Text As String
0007Dim i As Long
0008Dim j As Long
0009Dim iFunctor_End As Long
0010Dim k As Long
0011Dim m As Long
0012Dim Functor_ID_Parameter As String
0013Dim Functor_ID As Integer
0014Dim Functor_Option As Integer
0015Dim Functor_Parameter As String
0016Dim Embedded_Functor As Boolean
0017Dim field_Output(5)
0018Dim iTester As Integer
0019k = Len("<!-- FUNCTOR_ID=")
0020 strQuery = "DELETE * FROM Functor_Usage;"
0021DoCmd.RunSQL (strQuery)
0022 strQuery = "SELECT * FROM Functor_Usage;"
0023Set rs_Out = CurrentDb.OpenRecordset(strQuery)
0024 strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text FROM Notes WHERE (((Notes.Item_Text) Like ""*<!-- FUNCTOR_ID=*""));"
0025Set rs_In = CurrentDb.OpenRecordset(strQuery)
0026rs_In.MoveFirst
0027Do Until rs_In.EOF
0028 i = 1
0029 iFunctor_End = 0
0030 strNote_Text = rs_In.Fields(2)
0031 i = InStr(i, strNote_Text, "<!-- FUNCTOR_ID=")
0032 Do Until i = 0
0033 j = InStr(i + 1, strNote_Text, "-->")
0034 If j > 0 Then
0035 If i < iFunctor_End Then
0036 Embedded_Functor = True
0037 Else
0038 Embedded_Functor = False
0039 End If
0040 iFunctor_End = InStr(i + 1, strNote_Text, "<!-- FUNCTOR_END")
0041 Functor_ID_Parameter = Trim(Mid(strNote_Text, i + k, j - i - k))
0042 j = InStr(Functor_ID_Parameter, ",")
0043 If j = 0 Then
0044 Functor_ID = Trim(Functor_ID_Parameter)
0045 Functor_Option = 0
0046 Functor_Parameter = ""
0047 Else
0048 Functor_ID = Trim(Left(Functor_ID_Parameter, j - 1))
0049 m = InStr(j + 1, Functor_ID_Parameter, ",")
0050 If m = 0 Then
0051 Functor_Option = Trim(Mid(Functor_ID_Parameter, j + 1))
0052 Functor_Parameter = ""
0053 Else
0054 Functor_Option = Trim(Mid(Functor_ID_Parameter, j + 1, m - j))
0055 Functor_Parameter = Trim(Mid(Functor_ID_Parameter, m + 1))
0056 m = InStr(Functor_Parameter, ",")
0057 If m = 1 Then 'Missing 1st parameter ... 2nd parameter follows (ignored for now)
0058 Functor_Parameter = ""
0059 End If
0060 End If
0061 End If
0062 field_Output(0) = rs_In.Fields(0)
0063 field_Output(1) = Functor_ID
0064 field_Output(2) = Functor_Option
0065 field_Output(3) = Functor_Parameter
0066 field_Output(4) = Embedded_Functor
0067 strQuery = "SELECT Functor_Usage.Note_ID FROM Functor_Usage WHERE (((Functor_Usage.Note_ID)=" & field_Output(0) & ") AND ((Functor_Usage.Functor_ID)= " & field_Output(1) & ") AND ((Functor_Usage.Functor_Option)= " & field_Output(2) & ") AND ((Functor_Usage.Functor_Parameter)=""" & field_Output(3) & """) AND ((Functor_Usage.[Embedded?])= " & field_Output(4) & "));"
0068 Set rs_Test = CurrentDb.OpenRecordset(strQuery)
0069 If rs_Test.EOF Then
0070 'Add to database
0071 rs_Out.AddNew
0072 For m = 0 To 4
0073 rs_Out.Fields(m) = field_Output(m)
0074 Next m
0075 rs_Out.Fields(5) = Now()
0076 rs_Out.Update
0077 End If
0078 Set rs_Test = Nothing
0079 'Next Functor
0080 i = InStr(i + 1, strNote_Text, "<!-- FUNCTOR_ID=")
0081 Else
0082 i = 0
0083 End If
0084 Loop
0085 rs_In.MoveNext
0086Loop
0087Set rs_In = Nothing
0088End Sub

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


Source Code of: Functor_06
Procedure Type: Public Function
Module: Functors
Lines of Code: 51
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_06(strQuery, strNote_Text)
0002'Status: Web-Tools Report - Priority 1 Outstanding Developments by Category
0003Dim rs As Recordset
0004Dim strNote_Text_Local
0005Dim Priority As Integer
0006Dim Category As String
0007Dim Status As String
0008Dim Development As String
0009Dim Category_Saved As String
0010Dim strCategory_Text As String
0011strNote_Text_Local = ""
0012Category_Saved = "ZZZZZ"
0013strCategory_Text = ""
0014Set rs = CurrentDb.OpenRecordset(strQuery)
0015If Not rs.EOF Then
0016 rs.MoveFirst
0017 Functor_06 = "Yes"
0018Else
0019 Functor_06 = "No"
0020 Exit Function
0021End If
0022Do Until rs.EOF
0023 Category = rs.Fields(0) & ""
0024 Priority = rs.Fields(1)
0025 Status = rs.Fields(2) & ""
0026 Development = rs.Fields(3) & ""
0027 If Category <> Category_Saved Then
0028 If Category_Saved <> "ZZZZZ" Then
0029 'Finalise Previous Priority
0030 strCategory_Text = "|ii|" & strCategory_Text & "|ii|"
0031 strCategory_Text = "|.|<b>" & Category_Saved & "</b>" & strCategory_Text
0032 End If
0033 'Ready for next Period
0034 strNote_Text_Local = strNote_Text_Local & strCategory_Text
0035 strCategory_Text = ""
0036 End If
0037 strCategory_Text = strCategory_Text & "|1|" & Development
0038 'Move on ...
0039 Category_Saved = Category
0040 rs.MoveNext
0041Loop
0042'Finish the list ...
0043strCategory_Text = "|ii|" & strCategory_Text & "|ii|"
0044strCategory_Text = "|.|<b>" & Category_Saved & "</b>" & strCategory_Text
0045strNote_Text_Local = strNote_Text_Local & strCategory_Text
0046'Top and Tail
0047strNote_Text_Local = "<b><u>Priority 1 Items By Category</u>:-</b> |##|" & strNote_Text_Local & "|##|"
0048'Tidy up
0049Set rs = Nothing
0050strNote_Text = strNote_Text_Local
0051End Function

Procedures Calling This Procedure (Functor_06) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Kaprekar_Main
Procedure Type: Public Sub
Module: Testing
Lines of Code: 75
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Kaprekar_Main()
0002Dim Test_Number As Long
0003Dim Test_Number_String As String
0004Dim Sort_Array(11) As Integer
0005Dim i As Integer
0006Dim j As Integer
0007Dim k As LongLong
0008Dim m As LongLong
0009Dim Test_Number_Small As String
0010Dim Test_Number_Large As String
0011Dim Test_Number_Next As String
0012Dim Test_Number_Saved As String
0013Dim Done_Number As Boolean
0014Dim iNumber_Size As Integer
0015Dim rs As Recordset
0016iNumber_Size = 4
0017 DoCmd.RunSQL ("Delete Kaprekar_Counts.* from Kaprekar_Counts where Kaprekar_Counts.Length = " & iNumber_Size & ";")
0018 Set rs = CurrentDb.OpenRecordset("Select Kaprekar_Counts.* from Kaprekar_Counts;")
0019For m = 1 To 10 ^ iNumber_Size - 1
0020 Done_Number = False
0021 Test_Number = 10 ^ iNumber_Size + m
0022 Test_Number_String = Mid(Test_Number, 2)
0023 Test_Number_Next = Test_Number_String
0024 k = 1
0025 Test_Number_Saved = ""
0026 Do Until Done_Number = True
0027 'Clear sort array
0028 For i = 1 To 11
0029 Sort_Array(i) = 0
0030 Next i
0031 'Sort digits
0032 For i = 1 To iNumber_Size
0033 j = Mid(Test_Number_Next, i, 1)
0034 Sort_Array(j + 1) = Sort_Array(j + 1) + 1
0035 Next i
0036 'Smaller
0037 Test_Number_Small = ""
0038 For i = 1 To 11
0039 For j = 1 To Sort_Array(i)
0040 Test_Number_Small = Test_Number_Small & i - 1
0041 Next j
0042 Next i
0043 'Debug.Print Test_Number_Small
0044 'Larger
0045 Test_Number_Large = ""
0046 For i = 1 To iNumber_Size
0047 Test_Number_Large = Test_Number_Large & Mid(Test_Number_Small, iNumber_Size + 1 - i, 1)
0048 Next i
0049 'Debug.Print Test_Number_Large
0050 Test_Number = Val(Test_Number_Large) - Val(Test_Number_Small)
0051 Test_Number = 10 ^ iNumber_Size + Test_Number
0052 Test_Number_Next = Mid(Test_Number, 2)
0053 If Test_Number_Saved = Test_Number_Next Then
0054 Done_Number = True
0055 Else
0056 Done_Number = False
0057 Test_Number_Saved = Test_Number_Next
0058 End If
0059 'Debug.Print Test_Number_Next; k
0060 k = k + 1
0061 If k > 20 Then
0062 Done_Number = True
0063 End If
0064 Loop
0065 'Debug.Print Test_Number_String; k - 2
0066 If k < 21 Then
0067 rs.AddNew
0068 rs.Fields(0) = iNumber_Size
0069 rs.Fields(1) = m
0070 rs.Fields(2) = k - 2
0071 rs.Fields(3) = Test_Number_Saved
0072 rs.Update
0073 End If
0074Next m
0075End Sub

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


Source Code of: Language_Animadversion_Translate
Procedure Type: Public Function
Module: Testing
Lines of Code: 39
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Language_Animadversion_Translate(strCell, Language)
0002Dim rs As Recordset
0003Dim strQuery As String
0004Dim strText_Local As String
0005Dim strLanguage As String
0006Dim i As Long
0007Dim j As Long
0008Dim k As Long
0009Dim The_Word As String
0010Dim strBracket As String
0011strText_Local = strCell
0012 strQuery = "SELECT Language_Animadversions_XRef1.Language FROM Language_Animadversions_XRef1 WHERE (((Language_Animadversions_XRef1.Language) <> ""General"")) ORDER BY Language_Animadversions_XRef1.Language;"
0013Set rs = CurrentDb.OpenRecordset(strQuery)
0014rs.MoveFirst
0015Do Until rs.EOF
0016 strLanguage = rs.Fields(0)
0017 If strLanguage <> Language Then
0018 i = InStr(strText_Local, strLanguage)
0019 Do Until i = 0
0020 j = FindWordEnd(strText_Local, i + Len(strLanguage) - 2, "]")
0021 k = FindWord(strText_Local, i)
0022 The_Word = Mid(strText_Local, k, j - k)
0023 If Right(The_Word, 1) = ")" Then
0024 The_Word = Left(The_Word, Len(The_Word) - 1)
0025 strBracket = ")"
0026 Else
0027 strBracket = ""
0028 End If
0029 If The_Word = strLanguage Then
0030 The_Word = The_Word & "++1313#" & strLanguage & "++"
0031 strText_Local = Left(strText_Local, k - 1) & The_Word & strBracket & Mid(strText_Local, j)
0032 End If
0033 i = InStr(i + Len(The_Word), strText_Local, strLanguage)
0034 Loop
0035 End If
0036 rs.MoveNext
0037Loop
0038Language_Animadversion_Translate = strText_Local
0039End Function

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


Source Code of: Link_Narr_Gen
Procedure Type: Public Function
Module: Spider
Lines of Code: 126
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Link_Narr_Gen(Link)
0002Dim Link_Local As String
0003Dim Link_Narr_Local As String
0004Dim rs As Recordset
0005Dim strQuery As String
0006Dim i As Integer
0007Dim j As Integer
0008Dim k As Integer
0009Dim Object_ID As Long
0010Dim SubObject_ID As Long
0011Dim Link_Narr_Addendum As String
0012Link_Local = Link
0013Link_Narr_Local = ""
0014'Abstracts
0015i = InStr(Link_Local, "Abstract_")
0016k = Len("Abstract_")
0017If i > 0 Then
0018 i = InStr(i + 1, Link_Local, "Abstract_")
0019 j = InStr(i + k, Link_Local, ".")
0020 Object_ID = Val(Mid(Link_Local, i + k, j - i - k)) 'Error with Documentation_Tables_Abstract_Footnotes
0021 strQuery = "SELECT Papers.Author, Papers.Title FROM Papers WHERE (((Papers.ID)=" & Object_ID & "));"
0022 Set rs = CurrentDb.OpenRecordset(strQuery)
0023 If Not rs.EOF Then
0024 rs.MoveFirst
0025 Link_Narr_Local = rs.Fields(0)
0026 i = InStr(Link_Narr_Local, "(")
0027 If i > 0 Then
0028 Link_Narr_Local = Left(Link_Narr_Local, i - 2)
0029 End If
0030 Link_Narr_Local = Link_Narr_Local & " - " & rs.Fields(1)
0031 'Debug.Print Now() & " - Link_Narr_Gen: " & Link & " - " & Link_Narr_Local
0032 End If
0033 GoTo Tidy_and_Exit
0034End If
0035'Paper Summaries
0036i = InStr(Link_Local, "PaperSummary_")
0037k = Len("PaperSummary_")
0038If i > 0 Then
0039 i = InStr(i + 1, Link_Local, "PaperSummary_")
0040 j = InStr(i + k, Link_Local, ".")
0041 If i > 0 Then
0042 Object_ID = Mid(Link_Local, i + k, j - i - k)
0043 strQuery = "SELECT Papers.Author, Papers.Title FROM Papers WHERE (((Papers.ID)=" & Object_ID & "));"
0044 Set rs = CurrentDb.OpenRecordset(strQuery)
0045 If Not rs.EOF Then
0046 rs.MoveFirst
0047 Link_Narr_Local = rs.Fields(0)
0048 i = InStr(Link_Narr_Local, "(")
0049 If i > 0 Then
0050 Link_Narr_Local = Left(Link_Narr_Local, i - 2)
0051 End If
0052 Link_Narr_Local = Link_Narr_Local & " - " & rs.Fields(1)
0053 'Debug.Print Now() & " - Link_Narr_Gen: " & Link & " - " & Link_Narr_Local
0054 End If
0055 End If
0056 GoTo Tidy_and_Exit
0057End If
0058'BookPaperAbstracts
0059i = InStr(Link_Local, "BookPaperAbstracts_")
0060k = Len("BookPaperAbstracts_")
0061If i > 0 Then
0062 j = InStr(i + k, Link_Local, ".")
0063 Object_ID = Val(Mid(Link_Local, i + k, j - i - k)) 'Error ... List
0064 strQuery = "SELECT Books.Author, Books.Title FROM Books WHERE (((Books.ID1)=" & Object_ID & "));"
0065 Set rs = CurrentDb.OpenRecordset(strQuery)
0066 If Not rs.EOF Then
0067 rs.MoveFirst
0068 Link_Narr_Local = rs.Fields(0)
0069 i = InStr(Link_Narr_Local, "(")
0070 If i > 0 Then
0071 Link_Narr_Local = Left(Link_Narr_Local, i - 2)
0072 End If
0073 Link_Narr_Local = Link_Narr_Local & " - " & rs.Fields(1)
0074 'Debug.Print Now() & " - Link_Narr_Gen: " & Link & " - " & Link_Narr_Local
0075 End If
0076 GoTo Tidy_and_Exit
0077End If
0078'Notes
0079Link_Narr_Addendum = ""
0080i = InStr(Link_Local, "Notes_")
0081k = Len("Notes_")
0082If i > 0 Then 'The 10 Concatenated Notes fail (safely) here ... these ... and a few others, plus the failures noted below, are not worth pursuing
0083 j = InStr(i + 1, Link_Local, "NotesPrint_")
0084 If j = 0 Then 'Not Notes Print ...
0085 i = InStr(i + 1, Link_Local, "Notes_")
0086 j = InStr(i + k, Link_Local, "_")
0087 If j = 0 Then 'Not an Archived Note
0088 j = InStr(i + k, Link_Local, ".")
0089 Object_ID = Mid(Link_Local, i + k, j - i - k)
0090 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.ID)=" & Object_ID & "));"
0091 Else
0092 If IsNumeric(Mid(Link_Local, i + k, j - i - k)) Then 'Notes Jump fail here! 16 items
0093 Object_ID = Mid(Link_Local, i + k, j - i - k)
0094 i = j + 1
0095 j = InStr(i, Link_Local, ".")
0096 If IsNumeric(Mid(Link_Local, i, j - i)) Then 'Notes Links fail here! 2 cases
0097 SubObject_ID = Mid(Link_Local, i, j - i)
0098 strQuery = "SELECT Notes_Archive.Item_Title FROM Notes_Archive WHERE (((Notes_Archive.ID)=" & Object_ID & ") AND Notes_Archive.Timestamp=" & SubObject_ID & ");"
0099 End If
0100 Link_Narr_Addendum = " (Archived Note)"
0101 End If
0102 End If
0103 Else
0104 i = j
0105 k = Len("NotesPrint_")
0106 j = InStr(i + k, Link_Local, "_")
0107 If j > 0 Then
0108 Object_ID = Mid(Link_Local, i + k, j - i - k)
0109 strQuery = "SELECT Notes.Item_Title FROM Notes WHERE (((Notes.ID)=" & Object_ID & "));"
0110 End If
0111 Link_Narr_Addendum = " (Printable Note)"
0112 End If
0113 If strQuery <> "" Then
0114 Set rs = CurrentDb.OpenRecordset(strQuery)
0115 If Not rs.EOF Then
0116 rs.MoveFirst
0117 Link_Narr_Local = rs.Fields(0) & Link_Narr_Addendum
0118 'Debug.Print Now() & " - Link_Narr_Gen: " & Link & " - " & Link_Narr_Local
0119 End If
0120 End If
0121 GoTo Tidy_and_Exit
0122End If
0123Tidy_and_Exit:
0124Set rs = Nothing
0125Link_Narr_Gen = Link_Narr_Local
0126End Function

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


Source Code of: Oboe_File_Links_List
Procedure Type: Public Function
Module: Testing
Lines of Code: 39
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Oboe_File_Links_List(Cell)
0002Dim rs As Recordset
0003Dim strString_Local As String
0004Dim strQuery As String
0005Dim strCell As String
0006Dim strElement As String
0007Dim i As Integer
0008Dim j As Integer
0009Dim Audio_ID As Integer
0010strCell = Cell
0011If strCell = "&nbsp;" Then
0012 Oboe_File_Links_List = strCell
0013 Exit Function
0014End If
0015i = 1
0016Do While i > 0
0017 j = InStr(i, strCell, ",")
0018 If j > 0 Then
0019 Audio_ID = Val(Mid(strCell, i, j - i))
0020 i = j + 1
0021 Else
0022 Audio_ID = Val(Mid(strCell, i, 10))
0023 i = 0
0024 End If
0025 strQuery = "SELECT Audio_Files.ID, Audio_Files.Creation_Date FROM Audio_Files WHERE (((Audio_Files.ID)=" & Audio_ID & "));"
0026 Set rs = CurrentDb.OpenRecordset(strQuery)
0027 If Not rs.EOF Then
0028 rs.MoveFirst
0029 strElement = "[" & rs.Fields(1) & "]++" & 879 & "#Oboe_Practice_" & Audio_ID & "++"
0030 Else
0031 strElement = "Unknown: " & Audio_ID
0032 End If
0033 If i > 0 Then
0034 strElement = strElement & ",<br>"
0035 End If
0036 strString_Local = strString_Local & strElement
0037Loop
0038Oboe_File_Links_List = strString_Local
0039End Function

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


Source Code of: PaperSumaryAbstract_Links
Procedure Type: Public Function
Module: New Code
Lines of Code: 34
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function PaperSumaryAbstract_Links(iPaper_Abstract_ID, iPaperID)
0002Dim strQuery As String
0003Dim strLine As String
0004Dim rs As Recordset
0005If iPaper_Abstract_ID = 0 Then
0006 'If this is really a book with a single Chapter logged, use the Book/Paper abstract
0007 strQuery = "SELECT Books.ID1, Count(Papers_1.ID) AS CountOfID FROM (Papers INNER JOIN Books ON Papers.Book_ID = Books.ID1) INNER JOIN Papers AS Papers_1 ON Books.ID1 = Papers_1.Book_ID WHERE (((Papers.ID) = " & iPaperID & ")) GROUP BY Books.ID1 HAVING (((Count(Papers_1.ID))=1));" 'Borrow this queryname!
0008 Set rs = CurrentDb.OpenRecordset(strQuery)
0009 If Not rs.EOF Then
0010 rs.MoveFirst
0011 strLine = "<A HREF = ""BookSummaries/BookSummary_" & Right(Str(Int(rs.Fields(0) / 1000) + 1000000), 2) & "/BookPaperAbstracts/BookPaperAbstracts_" & rs.Fields(0) & ".htm"">Abstract</A><BR>"
0012 strQuery = "SELECT Books.ID1, Quality_Markers.Display_Text, Quality_Markers.Icon FROM Books INNER JOIN Quality_Markers ON Books.Abstract_Quality = Quality_Markers.Quality WHERE (((Books.ID1)=" & rs.Fields(0) & "));"
0013 Set rs = CurrentDb.OpenRecordset(strQuery)
0014 If Not rs.EOF Then
0015 rs.MoveFirst
0016 strLine = strLine & "<span title=""" & rs.Fields(1) & """><img src=""" & rs.Fields(2) & """ alt= """ & rs.Fields(1) & """></span>"
0017 End If
0018 Else
0019 strLine = ""
0020 End If
0021 strLine = strLine & "<A HREF = ""PaperSummaries/PaperSummary_" & Right(Str(Int(iPaperID / 1000) + 1000000), 2) & "/PaperSummary_" & iPaperID & ".htm"">More</A>"
0022Else
0023 strLine = "<A HREF = ""Abstracts/Abstract_" & Right(Str(Int(iPaperID / 1000) + 1000000), 2) & "/Abstract_" & iPaperID & ".htm"">Abstract</A><BR>"
0024 strQuery = "SELECT Papers.ID, Quality_Markers.Display_Text, Quality_Markers.Icon FROM Papers INNER JOIN Quality_Markers ON Papers.Abstract_Quality = Quality_Markers.Quality WHERE (((Papers.ID)=" & iPaperID & "));"
0025 Set rs = CurrentDb.OpenRecordset(strQuery)
0026 If Not rs.EOF Then
0027 rs.MoveFirst
0028 strLine = strLine & "<span title=""" & rs.Fields(1) & """><img src=""" & rs.Fields(2) & """ alt= """ & rs.Fields(1) & """></span>"
0029 End If
0030 strLine = strLine & "<A HREF = ""PaperSummaries/PaperSummary_" & Right(Str(Int(iPaperID / 1000) + 1000000), 2) & "/PaperSummary_" & iPaperID & ".htm"">More</A>"
0031End If
0032PaperSumaryAbstract_Links = strLine
0033Set rs = Nothing
0034End Function

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


Source Code of: Spot_Invalid_Cognates
Procedure Type: Public Function
Module: Testing
Lines of Code: 15

Line-No. / Ref.Code Line
0001Public Function Spot_Invalid_Cognates(strWord, ByRef Cognate_Table() As Variant)
0002Dim i As Integer
0003Dim j As Integer
0004j = UBound(Cognate_Table())
0005Spot_Invalid_Cognates = "OK"
0006For i = 1 To j
0007 If InStr(strWord, Cognate_Table(i)) > 0 Then
0008 If Cognate_Table(i) & "" = "" Then
0009 i = j + 1
0010 Else
0011 Spot_Invalid_Cognates = "Dud"
0012 End If
0013 End If
0014Next i
0015End Function

Procedures Calling This Procedure (Spot_Invalid_Cognates) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Subject_Hours_List
Procedure Type: Public Function
Module: Testing
Lines of Code: 22
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Subject_Hours_List(Subject)
0002Dim rs As Recordset
0003Dim strString_Local As String
0004Dim strQuery As String
0005Dim Total_Hours As Single
0006 strQuery = "SELECT Language_Location_Primer.Language_Key, Year_Crosstab.Period, Sum(Year_Crosstab.Hours) AS SumOfHours FROM Language_Location_Primer INNER JOIN Year_Crosstab ON Language_Location_Primer.Timesheet_Subject = Year_Crosstab.Task_Group GROUP BY Language_Location_Primer.Language_Key, Year_Crosstab.Period HAVING (((Language_Location_Primer.Language_Key)=""" & Subject & """) AND ((Year_Crosstab.Period) Not Like ""*-*"") AND ((Sum(Year_Crosstab.Hours))>0)) ORDER BY Year_Crosstab.Period DESC;"
0007strString_Local = ""
0008Total_Hours = 0
0009Set rs = CurrentDb.OpenRecordset(strQuery)
0010If rs.EOF Then
0011 Subject_Hours_List = ""
0012Else
0013 rs.MoveFirst
0014 Do Until rs.EOF
0015 Total_Hours = Total_Hours + rs.Fields(2)
0016 strString_Local = strString_Local & ". <b>" & Left(rs.Fields(1), 4) & ":</b> " & rs.Fields(2)
0017 rs.MoveNext
0018 Loop
0019 strString_Local = "|.|<b>Hours by prior academic year: Total:</b> " & Total_Hours & strString_Local
0020 Subject_Hours_List = strString_Local & "<br>"
0021End If
0022End Function

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


© Theo Todman, June 2007 - Nov 2023. 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