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

Reference_FootNotesRegen_Note_Book_LinksRegen_Note_Paper_LinksRegen_Author_Book_Links
Regen_Author_Paper_LinksRegen_Book_Note_LinksRegen_Note_Links.

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

Go to top of page



Source Code of: Reference_FootNotes
Procedure Type: Public Function
Module: New Code
Lines of Code: 181
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Reference_FootNotes(strType, ID, strText, Optional strTitle)
0002'Segregates the text of Paper and Book abstracts into main text and footnotes, hyperlinked together.
0003'If strType = X, only the footnotes are seived out - this is to check for bullet conflict for book abstracts
0004Dim rsFootnotes As Recordset
0005Dim rsFNCheck As Recordset
0006Dim strQuery As String
0007Dim strFootnote As String
0008Dim x As Long
0009Dim xx As String
0010Dim i As Long
0011Dim No_FN As String
0012Dim FN_Start As Long
0013Dim FN_End As Long
0014Dim iSuperscript As Integer
0015Dim strLink1 As String
0016Dim strLink2 As String
0017Dim TheWord As String
0018Dim strName As String
0019Dim Last_Footnote_Bulletted As String
0020Dim strLine_Break As String
0021Dim FN_Count As Integer
0022Dim BlankSpace As String
0023Dim strDup_FNs As String
0024Dim iSuperscript_Display As Integer
0025'Delete Footnotes from Table
0026 strQuery = "DELETE Abstract_Footnotes.Object_Type, Abstract_Footnotes.Object_ID, Abstract_Footnotes.FN_ID, Abstract_Footnotes.FN_Text, Abstract_Footnotes.Timestamp, Abstract_Footnotes.Master_ID FROM Abstract_Footnotes WHERE (((Abstract_Footnotes.Object_Type)=""" & strType & """) AND ((Abstract_Footnotes.Object_ID)=" & ID & "));"
0027DoCmd.RunSQL (strQuery)
0028'Ready the Footnote Table
0029 strQuery = "SELECT Abstract_Footnotes.Object_Type, Abstract_Footnotes.Object_ID, Abstract_Footnotes.FN_ID, Abstract_Footnotes.FN_Text, Abstract_Footnotes.Timestamp, Abstract_Footnotes.Master_ID FROM Abstract_Footnotes WHERE (((Abstract_Footnotes.Object_Type)=""" & strType & """) AND ((Abstract_Footnotes.Object_ID)=" & ID & ")) ORDER BY Abstract_Footnotes.FN_ID;"
0030Set rsFootnotes = CurrentDb.OpenRecordset(strQuery)
0031iSuperscript = 1
0032FN_Count = 0
0033x = 1
0034x = InStr(x, strText, "++FN")
0035If x > 0 Then
0036 OK = Mark_Colours(strText)
0037 x = 1
0038 No_FN = "No"
0039 x = InStr(x, strText, "++")
0040 Do Until (No_FN = "Yes" And x = 0)
0041 If x > 0 Then
0042 If Mid(strText, x + 2, 2) = "FN" Then
0043 FN_Start = x
0044 x = x + 1
0045 x = InStr(x, strText, "++")
0046 If x > 0 Then
0047 FN_End = x + 1
0048 strFootnote = Mid(strText, FN_Start + 4, FN_End - FN_Start - 5) & ""
0049 If strFootnote = "" Then
0050 'Ignore null Footnotes - only used for documentation purposes!
0051 Else
0052 If Mid(strText, FN_Start - 1, 1) = " " Then
0053 i = FindWord(strText, FN_Start - 1, "]")
0054 Else
0055 i = FindWord(strText, FN_Start, "]")
0056 End If
0057 'Add to Array
0058 rsFootnotes.AddNew
0059 rsFootnotes.Fields(0) = strType
0060 rsFootnotes.Fields(1) = ID
0061 rsFootnotes.Fields(2) = iSuperscript
0062 rsFootnotes.Fields(3) = strFootnote
0063 rsFootnotes.Fields(4) = Now()
0064 rsFootnotes.Fields(5) = iSuperscript
0065 rsFootnotes.Update
0066 'Find if a duplicate FN
0067 OK = Mark_Duplicate_Abstract_Footnotes(strType, ID)
0068 Set rsFNCheck = CurrentDb.OpenRecordset("SELECT Abstract_Footnotes.Object_Type, Abstract_Footnotes.Object_ID, Abstract_Footnotes.FN_ID, Abstract_Footnotes.Master_ID FROM Abstract_Footnotes WHERE (((Abstract_Footnotes.Object_Type)=""" & strType & """) AND ((Abstract_Footnotes.Object_ID)=" & ID & ") AND ((Abstract_Footnotes.FN_ID)=" & iSuperscript & "));")
0069 rsFNCheck.MoveFirst
0070 If rsFNCheck.Fields(2) <> rsFNCheck.Fields(3) Then
0071 iSuperscript_Display = rsFNCheck.Fields(3)
0072 Else
0073 iSuperscript_Display = iSuperscript
0074 End If
0075 Set rsFNCheck = Nothing
0076 strLink1 = "<U><A HREF=""#On-Page_Link_" & strType & ID & "_" & iSuperscript_Display & """>"
0077 'Note ... leave a marker to enable Note referencing later on ...
0078 'strLink2 = "</A></U><SUB>" & iSuperscript & IIf(iSuperscript <> iSuperscript_Display, "=" & iSuperscript_Display, "") & "</SUB>" & "<a name=""On-Page_Return_" & strType & ID & "_" & iSuperscript & """></A>++FN++"
0079 '19/04/21 - removed the "x=y" FN subscripting: looks silly and is unneccessary.
0080 strLink2 = "</A></U><SUB>" & iSuperscript & "</SUB>" & "<a name=""On-Page_Return_" & strType & ID & "_" & iSuperscript & """></A>++FN++"
0081 If Mid(strText, FN_Start - 1, 1) = " " Then
0082 TheWord = Mid(strText, i, FN_Start - 1 - i)
0083 Else
0084 TheWord = Mid(strText, i, FN_Start - i)
0085 End If
0086 If Right(TheWord, 1) = "]" Then
0087 TheWord = Mid(TheWord, 2, Len(TheWord) - 2)
0088 End If
0089 If Left(TheWord, 1) = "(" Then
0090 TheWord = Mid(TheWord, 2)
0091 i = i + 1
0092 End If
0093 xx = Left(strText, i - 1) & strLink1 & TheWord & strLink2
0094 x = Len(xx)
0095 strText = xx & Mid(strText, FN_End + 1)
0096 iSuperscript = iSuperscript + 1
0097 FN_Count = FN_Count + 1
0098 End If
0099 x = x + 1
0100 x = InStr(x, strText, "++")
0101 End If
0102 Else
0103 No_FN = "Yes"
0104 'Ignore Note-links (ie. links to other Notes)
0105 'watch out for "++++" where the Note ID is to be deduced in due course
0106 If Mid(strText, x, 4) = "++++" Then
0107 x = x + 3
0108 Else
0109 x = x + 1
0110 x = InStr(x, strText, "++")
0111 End If
0112 If x > 0 Then
0113 x = x + 1
0114 x = InStr(x, strText, "++")
0115 iSuperscript = iSuperscript + 1
0116 End If
0117 End If
0118 Else
0119 No_FN = "Yes"
0120 End If
0121 Loop
0122End If
0123 OK = Mark_Duplicate_Abstract_Footnotes(strType, ID) 'Flag duplicate footnotes
0124If strType <> "X" Then
0125 'Write out the footnotes (if any)
0126 iSuperscript = 1
0127 If FN_Count > 0 Then
0128 If IsMissing(strTitle) Then
0129 strName = ""
0130 Else
0131 strName = strTitle
0132 strName = " (" & strName & ")"
0133 End If
0134 strText = strText & "<BR><HR><BR><U><B>In-Page Footnotes</U>" & strName & "</B>"
0135 Last_Footnote_Bulletted = "No"
0136 'Re-read Footnotes
0137 Set rsFootnotes = CurrentDb.OpenRecordset(strQuery)
0138 rsFootnotes.MoveFirst
0139 Do While Not rsFootnotes.EOF
0140 'Format the in-page Footnotes
0141 strFootnote = rsFootnotes.Fields(3) & ""
0142 iSuperscript = rsFootnotes.Fields(2)
0143 If strFootnote <> "" Then
0144 If rsFootnotes(2) = rsFootnotes(5) Then 'Allow for Duplicate FNs
0145 If Last_Footnote_Bulletted = "Yes" Then
0146 strLine_Break = ""
0147 Else
0148 strLine_Break = "<BR><BR>"
0149 End If
0150 BlankSpace = Right(Trim(strFootnote), 20)
0151 If InStr(BlankSpace, "|..|") > 0 Or InStr(BlankSpace, "|99|") > 0 Or InStr(BlankSpace, "|ii|") > 0 Or InStr(BlankSpace, "|II|") > 0 Or InStr(BlankSpace, "|aa|") > 0 Or InStr(BlankSpace, "|AA|") > 0 Or InStr(BlankSpace, "|##|") > 0 Then 'Determine if the footnote ends in a bulleted list. If so, don't add line breaks next time ...
0152 'Changed 16/02/2014 to allow for non-text - eg. |Colour_x| - at the end
0153 Last_Footnote_Bulletted = "Yes"
0154 Else
0155 Last_Footnote_Bulletted = "No"
0156 End If
0157 'Check, and list, Duplicate FNs
0158 strDup_FNs = ""
0159 Set rsFNCheck = CurrentDb.OpenRecordset("SELECT Abstract_Footnotes.Object_Type, Abstract_Footnotes.Object_ID, Abstract_Footnotes.FN_ID, Abstract_Footnotes.Master_ID FROM Abstract_Footnotes WHERE (((Abstract_Footnotes.Object_Type) = """ & strType & """) And ((Abstract_Footnotes.Object_ID) = " & ID & ") And ((Abstract_Footnotes.FN_ID) <> [Abstract_Footnotes]![Master_ID]) And ((Abstract_Footnotes.Master_ID) = " & rsFootnotes(2) & ")) ORDER BY Abstract_Footnotes.FN_ID;")
0160 If Not rsFNCheck.EOF Then
0161 rsFNCheck.MoveFirst
0162 Do While Not rsFNCheck.EOF
0163 strDup_FNs = strDup_FNs & "<A HREF=""#On-Page_Return_" & strType & ID & "_" & rsFNCheck.Fields(2).Value & """>, " & rsFNCheck.Fields(2).Value & "</A>"
0164 rsFNCheck.MoveNext
0165 Loop
0166 End If
0167 Set rsFNCheck = Nothing
0168 strText = strText & "<a name=""On-Page_Link_" & strType & ID & "_" & iSuperscript & """></A>" & strLine_Break & "<U><A HREF=""#On-Page_Return_" & strType & ID & "_" & iSuperscript & """>" & "<B>Footnote" & IIf(strDup_FNs = "", " ", "s ") & iSuperscript & "</A>" & strDup_FNs & "</B></U>: " & strFootnote
0169 End If
0170 End If
0171 rsFootnotes.MoveNext
0172 Loop
0173 BlankSpace = Right(Trim(strText), 20)
0174 If InStr(BlankSpace, "|..|") > 0 Or InStr(BlankSpace, "|99|") > 0 Or InStr(BlankSpace, "|ii|") > 0 Or InStr(BlankSpace, "|II|") > 0 Or InStr(BlankSpace, "|aa|") > 0 Or InStr(BlankSpace, "|AA|") > 0 Or InStr(BlankSpace, "|##|") > 0 Then 'Determine if the footnote ends in a bulleted list. If so, don't add line breaks next time ...
0175 Else
0176 strText = strText & "<BR><BR>"
0177 End If
0178 End If
0179End If
0180Set rsFootnotes = Nothing
0181End Function

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


Source Code of: Regen_Author_Book_Links
Procedure Type: Public Sub
Module: New Code
Lines of Code: 87
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Regen_Author_Book_Links()
0002Dim strControlQuery As String
0003Dim strLine As String
0004Dim rsTableToRead As Recordset
0005Dim rsAuthorBookLinks As Recordset
0006Dim x As Long
0007Dim Y As Long
0008Dim z As Long
0009Dim Names_Found As String
0010Dim Author As String
0011Dim Author_Letter As String
0012'Read Book records
0013 strControlQuery = "SELECT Books.Author, Books.Title, Books.ID1, Books.[Author & Title] FROM Books ORDER BY Books.Author;"
0014Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0015rsTableToRead.MoveFirst
0016'Ready the Author_Book_Links_Temp Table
0017 DoCmd.RunSQL ("DELETE Author_Book_Links_Temp.* FROM Author_Book_Links_Temp;")
0018 strControlQuery = "SELECT Author_Book_Links_Temp.* FROM Author_Book_Links_Temp;"
0019Set rsAuthorBookLinks = CurrentDb.OpenRecordset(strControlQuery)
0020'Regenerate the Author_Book_Links Table
0021Do While Not rsTableToRead.EOF
0022 strLine = rsTableToRead.Fields(0)
0023 x = 1
0024 Y = InStr(x, strLine, ",")
0025 z = InStr(x, strLine, "&")
0026 Names_Found = "No"
0027 'Interrogate the "Author" column
0028 Do Until Names_Found = "Yes"
0029 If Y + z = 0 Then
0030 Names_Found = "Yes"
0031 Author = Trim(Mid(strLine, x, Len(strLine)))
0032 Else
0033 If z = 0 Then
0034 Author = Trim(Mid(strLine, x, Y - x))
0035 x = Y + 1
0036 Else
0037 If Y = 0 Then
0038 Author = Trim(Mid(strLine, x, z - x))
0039 x = z + 1
0040 Else
0041 If Y > z Then
0042 Author = Trim(Mid(strLine, x, z - x))
0043 x = z + 1
0044 Else
0045 Author = Trim(Mid(strLine, x, Y - x))
0046 x = Y + 1
0047 End If
0048 End If
0049 End If
0050 End If
0051 'Ignore non-alpha's
0052 Author_Letter = UCase(Left(Author, 1))
0053 If Author_Letter < "A" Or Author_Letter > "Z" Then
0054 Author = "Dud"
0055 End If
0056 'Write out Author_Book_Links record
0057 Select Case Author
0058 Case "Dud"
0059 Case "Ed."
0060 Case "Eds."
0061 Case "Etc"
0062 Case "Etc."
0063 Case Else
0064 rsAuthorBookLinks.AddNew
0065 rsAuthorBookLinks!Author = Author
0066 rsAuthorBookLinks!Book_Author = rsTableToRead.Fields(0).Value
0067 rsAuthorBookLinks!Book_Title = rsTableToRead.Fields(1).Value
0068 rsAuthorBookLinks!Book_ID1 = rsTableToRead.Fields(2).Value
0069 rsAuthorBookLinks!Book_Author_Title = rsTableToRead.Fields(3).Value
0070 rsAuthorBookLinks![Timestamp] = Now()
0071 rsAuthorBookLinks.Update
0072 End Select
0073 'More Authors?
0074 If Names_Found = "No" Then
0075 Y = InStr(x, strLine, ",")
0076 z = InStr(x, strLine, "&")
0077 End If
0078 Loop
0079 rsTableToRead.MoveNext
0080Loop
0081'Now update the Author_Book_Links table
0082'Add new Links
0083 DoCmd.RunSQL ("INSERT INTO Author_Book_Links ( Author, Book_Author, Book_Title, Book_ID1, Book_Author_Title, [Timestamp] ) SELECT Author_Book_Links_Temp.Author, Author_Book_Links_Temp.Book_Author, Author_Book_Links_Temp.Book_Title, Author_Book_Links_Temp.Book_ID1, Author_Book_Links_Temp.Book_Author_Title, Author_Book_Links_Temp.Timestamp FROM Author_Book_Links_Temp LEFT JOIN Author_Book_Links ON (Author_Book_Links_Temp.Book_ID1 = Author_Book_Links.Book_ID1) AND (Author_Book_Links_Temp.Author = Author_Book_Links.Author) WHERE (((Author_Book_Links.Author) Is Null));")
0084'Delete unused links
0085 DoCmd.RunSQL ("UPDATE Author_Book_Links LEFT JOIN Author_Book_Links_Temp ON (Author_Book_Links.Book_ID1 = Author_Book_Links_Temp.Book_ID1) AND (Author_Book_Links.Author = Author_Book_Links_Temp.Author) SET Author_Book_Links.Zap_Flag = Yes WHERE (((Author_Book_Links_Temp.Author) Is Null));")
0086 DoCmd.RunSQL ("DELETE Author_Book_Links.Zap_Flag FROM Author_Book_Links WHERE (((Author_Book_Links.Zap_Flag)=Yes));")
0087End Sub

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


Source Code of: Regen_Author_Paper_Links
Procedure Type: Public Sub
Module: New Code
Lines of Code: 87
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Regen_Author_Paper_Links()
0002Dim strControlQuery As String
0003Dim strLine As String
0004Dim rsTableToRead As Recordset
0005Dim rsAuthorPaperLinks As Recordset
0006Dim x As Long
0007Dim Y As Long
0008Dim z As Long
0009Dim Names_Found As String
0010Dim Author As String
0011Dim Author_Letter As String
0012'Read Paper records
0013 strControlQuery = "SELECT Papers.Author, Papers.Title, Papers.ID, Papers.Book FROM Papers ORDER BY Papers.Author;"
0014Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0015rsTableToRead.MoveFirst
0016'Ready the Author_Paper_Links_Temp Table
0017 DoCmd.RunSQL ("DELETE Author_Paper_Links_Temp.* FROM Author_Paper_Links_Temp;")
0018 strControlQuery = "SELECT Author_Paper_Links_Temp.* FROM Author_Paper_Links_Temp;"
0019Set rsAuthorPaperLinks = CurrentDb.OpenRecordset(strControlQuery)
0020'Regenerate the Author_Paper_Links Table
0021Do While Not rsTableToRead.EOF
0022 strLine = rsTableToRead.Fields(0)
0023 x = 1
0024 Y = InStr(x, strLine, ",")
0025 z = InStr(x, strLine, "&")
0026 Names_Found = "No"
0027 'Interrogate the "Author" column
0028 Do Until Names_Found = "Yes"
0029 If Y + z = 0 Then
0030 Names_Found = "Yes"
0031 Author = Trim(Mid(strLine, x, Len(strLine)))
0032 Else
0033 If z = 0 Then
0034 Author = Trim(Mid(strLine, x, Y - x))
0035 x = Y + 1
0036 Else
0037 If Y = 0 Then
0038 Author = Trim(Mid(strLine, x, z - x))
0039 x = z + 1
0040 Else
0041 If Y > z Then
0042 Author = Trim(Mid(strLine, x, z - x))
0043 x = z + 1
0044 Else
0045 Author = Trim(Mid(strLine, x, Y - x))
0046 x = Y + 1
0047 End If
0048 End If
0049 End If
0050 End If
0051 'Ignore non-alpha's
0052 Author_Letter = UCase(Left(Author, 1))
0053 If Author_Letter < "A" Or Author_Letter > "Z" Then
0054 Author = "Dud"
0055 End If
0056 'Write out Author_Paper_Links record
0057 Select Case Author
0058 Case "Dud"
0059 Case "Ed."
0060 Case "Eds."
0061 Case "Etc"
0062 Case "Etc."
0063 Case Else
0064 rsAuthorPaperLinks.AddNew
0065 rsAuthorPaperLinks!Author = Author
0066 rsAuthorPaperLinks!Paper_Author = rsTableToRead.Fields(0).Value
0067 rsAuthorPaperLinks!Paper_Title = rsTableToRead.Fields(1).Value
0068 rsAuthorPaperLinks!Paper_ID = rsTableToRead.Fields(2).Value
0069 rsAuthorPaperLinks!Paper_Book = rsTableToRead.Fields(3).Value
0070 rsAuthorPaperLinks![Timestamp] = Now()
0071 rsAuthorPaperLinks.Update
0072 End Select
0073 'More Authors?
0074 If Names_Found = "No" Then
0075 Y = InStr(x, strLine, ",")
0076 z = InStr(x, strLine, "&")
0077 End If
0078 Loop
0079 rsTableToRead.MoveNext
0080Loop
0081'Now update the Author_Paper_Links table
0082'Add new Links
0083 DoCmd.RunSQL ("INSERT INTO Author_Paper_Links ( Author, Paper_Author, Paper_Title, Paper_ID, Paper_Book, [Timestamp] ) SELECT Author_Paper_Links_Temp.Author, Author_Paper_Links_Temp.Paper_Author, Author_Paper_Links_Temp.Paper_Title, Author_Paper_Links_Temp.Paper_ID, Author_Paper_Links_Temp.Paper_Book, Author_Paper_Links_Temp.Timestamp FROM Author_Paper_Links_Temp LEFT JOIN Author_Paper_Links ON (Author_Paper_Links_Temp.Paper_ID = Author_Paper_Links.Paper_ID) AND (Author_Paper_Links_Temp.Author = Author_Paper_Links.Author) WHERE (((Author_Paper_Links.Author) Is Null));")
0084'Delete unused links
0085 DoCmd.RunSQL ("UPDATE Author_Paper_Links LEFT JOIN Author_Paper_Links_Temp ON (Author_Paper_Links.Paper_ID = Author_Paper_Links_Temp.Paper_ID) AND (Author_Paper_Links.Author = Author_Paper_Links_Temp.Author) SET Author_Paper_Links.Zap_Flag = Yes WHERE (((Author_Paper_Links_Temp.Author) Is Null));")
0086 DoCmd.RunSQL ("DELETE Author_Paper_Links.Zap_Flag FROM Author_Paper_Links WHERE (((Author_Paper_Links.Zap_Flag)=Yes));")
0087End Sub

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


Source Code of: Regen_Book_Note_Links
Procedure Type: Public Sub
Module: New Code
Lines of Code: 137
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Regen_Book_Note_Links()
0002'This Process maintains the Book_Note_Links table, which records which Books reference which Notes ...
0003'This is in contrast to the Regen_Note_Book_Links Process which maintains the Note_Book_Links table, which records which Notes reference which Books ....
0004'Some day, I ought to combine these two tables ....
0005Dim strControlQuery As String
0006Dim strLine As String
0007Dim rsTableToRead As Recordset
0008Dim rsBookNoteLinks As Recordset
0009Dim x As Long
0010Dim Y As Long
0011Dim i As Long
0012Dim TheWord As String
0013Dim iNoteID As Integer
0014Dim rsNoteID As Recordset
0015'Read Book records
0016 strControlQuery = "SELECT Books.ID1, Books.[Author & Title], Books.Abstract, Books.Comments FROM Books ORDER BY Books.Author;"
0017Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0018'Ready the Book_Note_Links Table
0019 DoCmd.RunSQL ("DELETE Book_Note_Links.* FROM Book_Note_Links;")
0020 strControlQuery = "SELECT Book_Note_Links.* FROM Book_Note_Links;"
0021Set rsBookNoteLinks = CurrentDb.OpenRecordset(strControlQuery)
0022'Regenerate the Book_Note_Links Table
0023'New-style links
0024rsTableToRead.MoveFirst
0025Do While Not rsTableToRead.EOF
0026 strLine = rsTableToRead.Fields(2) & " " & rsTableToRead.Fields(3)
0027 x = 1
0028 x = InStr(x, strLine, "++")
0029 Do While x > 0
0030 Y = InStr(x + 1, strLine, "++")
0031 If Y > 0 Then
0032 If Y = x + 1 Then
0033 'Check this is the "++++" case where we have to look up the reference
0034 If Mid(strLine, x, 4) = "++++" Then
0035 'Find the key-word(s)
0036 If Mid(strLine, x - 1, 1) = " " Then
0037 i = FindWord(strLine, x - 1, "]")
0038 TheWord = Mid(strLine, i, x - 1 - i)
0039 Else
0040 i = FindWord(strLine, x, "]")
0041 TheWord = Mid(strLine, i, x - i)
0042 End If
0043 If Right(TheWord, 1) = "]" Then
0044 TheWord = Mid(TheWord, 2, Len(TheWord) - 2)
0045 End If
0046 'Find the Note ID. NB uses the Note_Alternates table!
0047 Set rsNoteID = CurrentDb.OpenRecordset("SELECT Notes.ID FROM Note_Alternates INNER JOIN Notes ON Note_Alternates.Item_Title = Notes.Item_Title WHERE (((Note_Alternates.Item_Alt_Title)=""" & TheWord & """));")
0048 If rsNoteID.EOF Then
0049 iNoteID = 1256 'The "dud links" Note!
0050 Else
0051 rsNoteID.MoveFirst
0052 iNoteID = rsNoteID.Fields(0)
0053 End If
0054 Set rsNoteID = Nothing
0055 strLine = Left(strLine, x + 1) & iNoteID & Mid(strLine, x + 2)
0056 Y = Y + 1 + Len(iNoteID)
0057 End If
0058 Else
0059 If IsNumeric(Mid(strLine, x + 2, Y - x - 2)) Then
0060 iNoteID = Mid(strLine, x + 2, Y - x - 2)
0061 'Add the Book_Note_Links link
0062 rsBookNoteLinks.AddNew
0063 rsBookNoteLinks!Book_ID1 = rsTableToRead.Fields(0)
0064 rsBookNoteLinks!Book_Author_Title = rsTableToRead.Fields(1)
0065 rsBookNoteLinks!Note_ID = iNoteID
0066 rsBookNoteLinks![Timestamp] = Now()
0067 rsBookNoteLinks.Update
0068 Else
0069 Y = x + 1
0070 End If
0071 End If
0072 Else
0073 Y = x + 1
0074 End If
0075 x = InStr(Y + 1, strLine, "++")
0076 Loop
0077 rsTableToRead.MoveNext
0078Loop
0079'Old-style links
0080rsTableToRead.MoveFirst
0081Do While Not rsTableToRead.EOF
0082 strLine = rsTableToRead.Fields(2) & " " & rsTableToRead.Fields(3)
0083 x = 1
0084 x = InStr(x, strLine, "+N")
0085 Do While x > 0
0086 Y = InStr(x + 1, strLine, "N+")
0087 If Y = x + 2 Then
0088 'Check this is the "+NN+" case where we have to look up the reference
0089 If Mid(strLine, x, 4) = "+NN+" Then
0090 'Find the key-word(s)
0091 If Mid(strLine, x - 1, 1) = " " Then
0092 i = FindWord(strLine, x - 1, "]")
0093 TheWord = Mid(strLine, i, x - 1 - i)
0094 Else
0095 i = FindWord(strLine, x, "]")
0096 TheWord = Mid(strLine, i, x - i)
0097 End If
0098 If Right(TheWord, 1) = "]" Then
0099 TheWord = Mid(TheWord, 2, Len(TheWord) - 2)
0100 End If
0101 'Find the Note ID. NB uses the Note_Alternates table!
0102 Set rsNoteID = CurrentDb.OpenRecordset("SELECT Notes.ID FROM Note_Alternates INNER JOIN Notes ON Note_Alternates.Item_Title = Notes.Item_Title WHERE (((Note_Alternates.Item_Alt_Title)=""" & TheWord & """));")
0103 If rsNoteID.EOF Then
0104 iNoteID = 1256 'The "dud links" Note!
0105 Else
0106 rsNoteID.MoveFirst
0107 iNoteID = rsNoteID.Fields(0)
0108 End If
0109 Set rsNoteID = Nothing
0110 strLine = Left(strLine, x + 1) & iNoteID & Mid(strLine, x + 2)
0111 Y = Y + 1 + Len(iNoteID)
0112 Else
0113 iNoteID = Mid(strLine, x + 2, Y - x - 2)
0114 End If
0115 Else
0116 TheWord = Mid(strLine, x + 2, Y - x - 2)
0117 i = InStr(TheWord, "#")
0118 If i > 0 Then
0119 iNoteID = Left(TheWord, i - 1)
0120 Else
0121 iNoteID = TheWord
0122 End If
0123 End If
0124 'Add the Book_Note_Links link
0125 If iNoteID > 0 Then
0126 rsBookNoteLinks.AddNew
0127 rsBookNoteLinks!Book_ID1 = rsTableToRead.Fields(0)
0128 rsBookNoteLinks!Book_Author_Title = rsTableToRead.Fields(1)
0129 rsBookNoteLinks!Note_ID = iNoteID
0130 rsBookNoteLinks![Timestamp] = Now()
0131 rsBookNoteLinks.Update
0132 End If
0133 x = InStr(Y + 1, strLine, "+N")
0134 Loop
0135 rsTableToRead.MoveNext
0136Loop
0137End Sub

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


Source Code of: Regen_Note_Book_Links
Procedure Type: Public Function
Module: New Code
Lines of Code: 91
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Regen_Note_Book_Links(rsTableToRead As Recordset, fldNote_ID, fldNote_Text, fldNote_Timestamp)
0002Dim strControlQuery As String
0003Dim strLine As String
0004Dim rsNoteBookLinks As Recordset
0005Dim rsNoteBookLinks_Checker As Recordset
0006Dim iSection As Integer
0007Dim iFootNoteID As Integer
0008Dim x As Long
0009Dim Y As Long
0010Dim z As Long
0011Dim ID As Integer
0012Dim iTimestamp As Long
0013'Delete old links
0014 DoCmd.RunSQL ("DELETE Note_Book_Links_Temp.* FROM Note_Book_Links_Temp;")
0015If Not rsTableToRead.EOF Then
0016 rsTableToRead.MoveFirst
0017 Do Until rsTableToRead.EOF
0018 ID = rsTableToRead.Fields(fldNote_ID)
0019 iTimestamp = rsTableToRead.Fields(fldNote_Timestamp)
0020 strControlQuery = "INSERT INTO Note_Book_Links_Temp ( [Note], Note_Ref, Book, [Timestamp], Origin, Date_Created ) SELECT Note_Book_Links.Note, Note_Book_Links.Note_Ref, Note_Book_Links.Book, Note_Book_Links.Timestamp, Note_Book_Links.Origin, Note_Book_Links.Date_Created FROM Note_Book_Links WHERE (((Note_Book_Links.Note)=" & ID & ") AND ((Note_Book_Links.Timestamp)=" & iTimestamp & "));"
0021 DoCmd.RunSQL (strControlQuery)
0022 rsTableToRead.MoveNext
0023 Loop
0024 rsTableToRead.MoveFirst
0025End If
0026 strControlQuery = "DELETE Note_Book_Links.* FROM Note_Book_Links INNER JOIN Note_Book_Links_Temp ON (Note_Book_Links.Origin = Note_Book_Links_Temp.Origin) AND (Note_Book_Links.Timestamp = Note_Book_Links_Temp.Timestamp) AND (Note_Book_Links.Book = Note_Book_Links_Temp.Book) AND (Note_Book_Links.Note_Ref = Note_Book_Links_Temp.Note_Ref) AND (Note_Book_Links.Note = Note_Book_Links_Temp.Note);"
0027DoCmd.RunSQL (strControlQuery)
0028 DoCmd.RunSQL ("DELETE Note_Book_Links_Temp.* FROM Note_Book_Links_Temp;")
0029'Ready the Note_Book_Links_Temp Table
0030 strControlQuery = "SELECT Note_Book_Links_Temp.* FROM Note_Book_Links_Temp WHERE Note_Book_Links_Temp![Timestamp] = " & 99 & ";"
0031Set rsNoteBookLinks = CurrentDb.OpenRecordset(strControlQuery)
0032If Not rsTableToRead.EOF Then
0033 rsTableToRead.MoveFirst
0034 'Regenerate the Note-Book Links
0035 Do While Not rsTableToRead.EOF
0036 strLine = rsTableToRead.Fields(fldNote_Text)
0037 strLine = ReplaceCode(strLine, Chr(13) & Chr(10), "<BR>")
0038 x = 1
0039 x = InStr(x, strLine, "+B")
0040 z = 1
0041 iSection = 0
0042 If x > 0 Then
0043 z = InStr(x, strLine, "<BR>")
0044 End If
0045 Do While x > 0
0046 Y = InStr(x + 1, strLine, "B+")
0047 If Y - x > 2 Then
0048 'Need to check (a) false links and (b) for the same link in the same section
0049 If IsNumeric(Mid(strLine, x + 2, Y - x - 2)) Then
0050 If x > z Then
0051 z = InStr(z + 20, strLine, "<BR>")
0052 If z = 0 Then
0053 z = 10000000
0054 End If
0055 iSection = iSection + 1
0056 End If
0057 strControlQuery = "SELECT Note_Book_Links_Temp.Note, Note_Book_Links_Temp.Note_Ref, Note_Book_Links_Temp.Book, Note_Book_Links_Temp.Timestamp, Note_Book_Links_Temp.Origin FROM Note_Book_Links_Temp WHERE (((Note_Book_Links_Temp.Note)=" & rsTableToRead.Fields(fldNote_ID) & ") AND ((Note_Book_Links_Temp.Note_Ref)=" & iSection & ") AND ((Note_Book_Links_Temp.Book)=" & iFootNoteID & ") AND ((Note_Book_Links_Temp.Timestamp)=" & rsTableToRead.Fields(fldNote_Timestamp) & ") AND ((Note_Book_Links_Temp.Origin)=""Note""));"
0058 Set rsNoteBookLinks_Checker = CurrentDb.OpenRecordset(strControlQuery)
0059 If rsNoteBookLinks_Checker.EOF Then
0060 iFootNoteID = Mid(strLine, x + 2, Y - x - 2)
0061 rsNoteBookLinks.AddNew
0062 rsNoteBookLinks!Note = rsTableToRead.Fields(fldNote_ID)
0063 rsNoteBookLinks!Note_Ref = iSection
0064 rsNoteBookLinks!Book = iFootNoteID
0065 rsNoteBookLinks![Timestamp] = rsTableToRead.Fields(fldNote_Timestamp)
0066 rsNoteBookLinks![Origin] = "Note"
0067 rsNoteBookLinks![Date_Created] = Now()
0068 On Error Resume Next 'Added 17/10/24 to 'resolve' duplicate key problem
0069 rsNoteBookLinks.Update
0070 End If
0071 Else
0072 If Y > 0 Then
0073 Y = x + 1
0074 Else
0075 Y = Len(strLine) - 1
0076 End If
0077 End If
0078 End If
0079 If Y = 0 Then
0080 Y = Len(strLine) - 1
0081 End If
0082 x = InStr(Y + 1, strLine, "+B")
0083 Loop
0084 rsTableToRead.MoveNext
0085 Loop
0086End If
0087'Copy Note_Book_Links_Temp to Note_Book_Links
0088 strControlQuery = "INSERT INTO Note_Book_Links SELECT Note_Book_Links_Temp.* FROM Note_Book_Links_Temp;"
0089DoCmd.RunSQL (strControlQuery)
0090Set rsNoteBookLinks = Nothing
0091End Function

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


Source Code of: Regen_Note_Links
Procedure Type: Public Sub
Module: New Code
Lines of Code: 161
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Regen_Note_Links()
0002Dim strControlQuery As String
0003Dim strLine As String
0004Dim rsTableToRead As Recordset
0005Dim rsNotesLinks As Recordset
0006Dim rsLatestTimestamp As Recordset
0007Dim x As Long
0008Dim Y As Long
0009Dim z As Long
0010Dim z_Saved As Long
0011Dim iSuperscript As Integer
0012Dim iSection As Integer
0013Dim iFootNoteID As Integer
0014Dim strPrintNote As String
0015Dim No_FN As String
0016Dim i As Long
0017Dim TheWord As String
0018Dim rsNoteID As Recordset
0019Dim Test_ID As Integer
0020'For testing ... set to Note of interest, else set to zero
0021Test_ID = 0
0022'Read Notes records
0023 strControlQuery = "SELECT Notes_List_Auto.* FROM Notes_List_Auto ORDER BY Notes_List_Auto.ID;"
0024Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0025rsTableToRead.MoveFirst
0026'Ready the Note Links
0027 DoCmd.RunSQL ("DELETE Note_Links.* FROM Note_Links;")
0028 strControlQuery = "SELECT Note_Links.* FROM Note_Links WHERE Note_Links![Timestamp] = " & Last_Changed_Timestamp & ";"
0029Set rsNotesLinks = CurrentDb.OpenRecordset(strControlQuery)
0030'Regenerate the Note Links
0031Do While Not rsTableToRead.EOF
0032 strLine = rsTableToRead.Fields(2)
0033 If rsTableToRead.Fields(11) & "" = "Temp" Then 'Find the latest archived Note, it any
0034 Set rsLatestTimestamp = CurrentDb.OpenRecordset("SELECT Notes_Archive.Item_Text, Notes_Archive.ID FROM Notes_Archive INNER JOIN Notes_Latest ON (Notes_Archive.Timestamp = Notes_Latest.Timestamp) AND (Notes_Archive.ID = Notes_Latest.ID) WHERE (((Notes_Archive.ID)=" & rsTableToRead.Fields(0) & "));")
0035 If Not rsLatestTimestamp.EOF Then
0036 rsLatestTimestamp.MoveFirst
0037 strLine = rsLatestTimestamp.Fields(0).Value
0038 End If
0039 Set rsLatestTimestamp = Nothing
0040 End If
0041 strLine = ReplaceCode(strLine, Chr(13) & Chr(10), "<BR>")
0042 x = 1
0043 z = 1
0044 iSuperscript = 1
0045 x = InStr(x, strLine, "++")
0046 iSection = 0
0047 Do While x > 0
0048 'Ignore In-sheet Footnotes
0049 No_FN = "No"
0050 Do Until No_FN = "Yes"
0051 If x > 0 Then
0052 If rsTableToRead.Fields(0) = Test_ID Then
0053 Debug.Print Now() & " - Regen_Note_Links: Note " & Test_ID & ". Offset=" & x & ". Text = """ & Mid(strLine, x, 50) & """"
0054 Stop
0055 End If
0056 If Mid(strLine, x + 2, 2) = "FN" Then
0057 x = x + 1
0058 x = InStr(x, strLine, "++")
0059 If x > 0 Then
0060 x = x + 1
0061 x = InStr(x, strLine, "++")
0062 iSuperscript = iSuperscript + 1
0063 End If
0064 Else
0065 No_FN = "Yes"
0066 End If
0067 Else
0068 No_FN = "Yes"
0069 End If
0070 Loop
0071 If x > 0 Then
0072 Y = InStr(x + 1, strLine, "++")
0073 If Mid(strLine, x + 2, 2) = "NP" Then
0074 If InStr(Mid(strLine, x + 4, Y - x - 4), "#") > 0 Then
0075 iFootNoteID = Left(Mid(strLine, x + 4, Y - x - 4), InStr(Mid(strLine, x + 4, Y - x - 4), "#") - 1)
0076 Else
0077 If IsNumeric(Mid(strLine, x + 4, Y - x - 4)) Then
0078 iFootNoteID = Mid(strLine, x + 4, Y - x - 4)
0079 Else
0080 iFootNoteID = 0
0081 End If
0082 End If
0083 strPrintNote = "No"
0084 Else
0085 If Y = x + 1 Then
0086 'Check this is the "++++" case where we have to look up the reference
0087 If Mid(strLine, x, 4) = "++++" Then
0088 'Find the key-word(s)
0089 If x > 1 Then
0090 If Mid(strLine, x - 1, 1) = " " Then
0091 i = FindWord(strLine, x - 1, "]")
0092 TheWord = Mid(strLine, i, x - 1 - i)
0093 Else
0094 i = FindWord(strLine, x, "]")
0095 TheWord = Mid(strLine, i, x - i)
0096 End If
0097 End If
0098 If Right(TheWord, 1) = "]" Then
0099 TheWord = Mid(TheWord, 2, Len(TheWord) - 2)
0100 End If
0101 'Find the Note ID. NB uses the Note_Alternates table!
0102 Set rsNoteID = CurrentDb.OpenRecordset("SELECT Notes.ID FROM Note_Alternates INNER JOIN Notes ON Note_Alternates.Item_Title = Notes.Item_Title WHERE (((Note_Alternates.Item_Alt_Title)=""" & TheWord & """));")
0103 If rsNoteID.EOF Then
0104 strPrintNote = "1256" 'The "dud links" Note!
0105 Else
0106 rsNoteID.MoveFirst
0107 strPrintNote = rsNoteID.Fields(0)
0108 End If
0109 Set rsNoteID = Nothing
0110 strLine = Left(strLine, x + 1) & strPrintNote & Mid(strLine, x + 2)
0111 Y = Y + 1 + Len(strPrintNote)
0112 End If
0113 Else
0114 strPrintNote = Mid(strLine, x + 2, Y - x - 2)
0115 End If
0116 If InStr(strPrintNote, "#") > 0 Then
0117 iFootNoteID = Left(strPrintNote, InStr(strPrintNote, "#") - 1)
0118 Else
0119 If IsNumeric(Mid(strLine, x + 2, Y - x - 2)) Then
0120 iFootNoteID = Mid(strLine, x + 2, Y - x - 2)
0121 Else
0122 iFootNoteID = 0
0123 End If
0124 End If
0125 strPrintNote = "Yes"
0126 End If
0127 If iFootNoteID > 0 Then
0128 rsNotesLinks.AddNew
0129 rsNotesLinks!Note_1 = rsTableToRead.Fields(0)
0130 If x > z Then
0131 Do While z < x
0132 z_Saved = z
0133 z = InStr(z + 20, strLine, "<BR>")
0134 If z = 0 Then
0135 z = 10000000
0136 End If
0137 iSection = iSection + 1
0138 Loop
0139 If z > 0 Then
0140 z = z_Saved
0141 iSection = iSection - 1
0142 End If
0143 End If
0144 rsNotesLinks!Note_1_Ref = iSection
0145 rsNotesLinks!Note_2 = iFootNoteID
0146 rsNotesLinks!Note_2_Ref = 0
0147 rsNotesLinks!Note_1_FN_ID = iSuperscript
0148 rsNotesLinks![Timestamp] = Last_Changed_Timestamp
0149 rsNotesLinks![Print_Note] = strPrintNote
0150 rsNotesLinks.Update
0151 End If
0152 x = InStr(Y + 1, strLine, "++")
0153 iSuperscript = iSuperscript + 1
0154 End If
0155 Loop
0156 rsTableToRead.MoveNext
0157Loop
0158Set rsTableToRead = Nothing
0159Set rsNotesLinks = Nothing
0160Set rsLatestTimestamp = Nothing
0161End Sub

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


Source Code of: Regen_Note_Paper_Links
Procedure Type: Public Function
Module: New Code
Lines of Code: 90
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Regen_Note_Paper_Links(rsTableToRead As Recordset, fldNote_ID, fldNote_Text, fldNote_Timestamp)
0002Dim strControlQuery As String
0003Dim strLine As String
0004Dim rsNotePaperLinks As Recordset
0005Dim rsNotePaperLinks_Checker As Recordset
0006Dim iSection As Integer
0007Dim iFootNoteID As Integer
0008Dim x As Long
0009Dim Y As Long
0010Dim z As Long
0011Dim ID As Integer
0012Dim iTimestamp As Long
0013'Delete old links
0014 DoCmd.RunSQL ("DELETE Note_Paper_Links_Temp.* FROM Note_Paper_Links_Temp;")
0015If Not rsTableToRead.EOF Then
0016 rsTableToRead.MoveFirst
0017 Do Until rsTableToRead.EOF
0018 ID = rsTableToRead.Fields(fldNote_ID)
0019 iTimestamp = rsTableToRead.Fields(fldNote_Timestamp)
0020 strControlQuery = "INSERT INTO Note_Paper_Links_Temp ( [Note], Note_Ref, Paper, [Timestamp], Origin, Date_Created ) SELECT Note_Paper_Links.Note, Note_Paper_Links.Note_Ref, Note_Paper_Links.Paper, Note_Paper_Links.Timestamp, Note_Paper_Links.Origin, Note_Paper_Links.Date_Created FROM Note_Paper_Links WHERE (((Note_Paper_Links.Note)=" & ID & ") AND ((Note_Paper_Links.Timestamp)=" & iTimestamp & "));"
0021 DoCmd.RunSQL (strControlQuery)
0022 rsTableToRead.MoveNext
0023 Loop
0024 rsTableToRead.MoveFirst
0025End If
0026 strControlQuery = "DELETE Note_Paper_Links.* FROM Note_Paper_Links INNER JOIN Note_Paper_Links_Temp ON (Note_Paper_Links.Origin = Note_Paper_Links_Temp.Origin) AND (Note_Paper_Links.Timestamp = Note_Paper_Links_Temp.Timestamp) AND (Note_Paper_Links.Paper = Note_Paper_Links_Temp.Paper) AND (Note_Paper_Links.Note_Ref = Note_Paper_Links_Temp.Note_Ref) AND (Note_Paper_Links.Note = Note_Paper_Links_Temp.Note);"
0027DoCmd.RunSQL (strControlQuery)
0028 DoCmd.RunSQL ("DELETE Note_Paper_Links_Temp.* FROM Note_Paper_Links_Temp;")
0029'Ready the Note_Paper_Links_Temp Table
0030 strControlQuery = "SELECT Note_Paper_Links_Temp.* FROM Note_Paper_Links_Temp WHERE Note_Paper_Links_Temp![Timestamp] = " & 99 & ";"
0031Set rsNotePaperLinks = CurrentDb.OpenRecordset(strControlQuery)
0032If Not rsTableToRead.EOF Then
0033 rsTableToRead.MoveFirst
0034 'Regenerate the Note-Paper Links
0035 Do While Not rsTableToRead.EOF
0036 strLine = rsTableToRead.Fields(fldNote_Text)
0037 strLine = ReplaceCode(strLine, Chr(13) & Chr(10), "<BR>")
0038 x = 1
0039 x = InStr(x, strLine, "+P")
0040 z = 1
0041 iSection = 0
0042 If x > 0 Then
0043 z = InStr(x, strLine, "<BR>")
0044 End If
0045 Do While x > 0
0046 Y = InStr(x + 1, strLine, "P+")
0047 If Y - x > 2 Then
0048 'Need to check (a) false links and (b) for the same link in the same section
0049 If IsNumeric(Mid(strLine, x + 2, Y - x - 2)) Then
0050 If x > z Then
0051 z = InStr(z + 15, strLine, "<BR>")
0052 If z = 0 Then
0053 z = 10000000
0054 End If
0055 iSection = iSection + 1
0056 End If
0057 strControlQuery = "SELECT Note_Paper_Links_Temp.Note, Note_Paper_Links_Temp.Note_Ref, Note_Paper_Links_Temp.Paper, Note_Paper_Links_Temp.Timestamp, Note_Paper_Links_Temp.Origin FROM Note_Paper_Links_Temp WHERE (((Note_Paper_Links_Temp.Note)=" & rsTableToRead.Fields(fldNote_ID) & ") AND ((Note_Paper_Links_Temp.Note_Ref)=" & iSection & ") AND ((Note_Paper_Links_Temp.Paper)=" & iFootNoteID & ") AND ((Note_Paper_Links_Temp.Timestamp)=" & rsTableToRead.Fields(fldNote_Timestamp) & ") AND ((Note_Paper_Links_Temp.Origin)=""Note""));"
0058 Set rsNotePaperLinks_Checker = CurrentDb.OpenRecordset(strControlQuery)
0059 If rsNotePaperLinks_Checker.EOF Then
0060 iFootNoteID = Mid(strLine, x + 2, Y - x - 2)
0061 rsNotePaperLinks.AddNew
0062 rsNotePaperLinks!Note = rsTableToRead.Fields(fldNote_ID)
0063 rsNotePaperLinks!Note_Ref = iSection
0064 rsNotePaperLinks!Paper = iFootNoteID
0065 rsNotePaperLinks![Timestamp] = rsTableToRead.Fields(fldNote_Timestamp)
0066 rsNotePaperLinks![Origin] = "Note"
0067 rsNotePaperLinks![Date_Created] = Now()
0068 rsNotePaperLinks.Update
0069 End If
0070 Else
0071 If Y > 0 Then
0072 Y = x + 1
0073 Else
0074 Y = Len(strLine) - 1
0075 End If
0076 End If
0077 End If
0078 If Y = 0 Then
0079 Y = Len(strLine) - 1
0080 End If
0081 x = InStr(Y + 1, strLine, "+P")
0082 Loop
0083 rsTableToRead.MoveNext
0084 Loop
0085End If
0086'Copy Note_Paper_Links_Temp to Note_Paper_Links
0087 strControlQuery = "INSERT INTO Note_Paper_Links SELECT Note_Paper_Links_Temp.* FROM Note_Paper_Links_Temp;"
0088DoCmd.RunSQL (strControlQuery)
0089Set rsNotePaperLinks = Nothing
0090End Function

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


© Theo Todman, June 2007 - May 2025. Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Philosophy Page Return to Theo Todman's Home Page