Line-No. / Ref. | Code Line |
0001 | Public Sub Auto_Reference_Notes(Optional Auto_Local) |
0002 | Dim rsKeyWords As Recordset |
0003 | Dim rsKeyWords_Update As Recordset |
0004 | Dim rsObject As Recordset |
0005 | Dim rsNotes_To_Regen As Recordset |
0006 | Dim rsNotes_To_Regen_Temp As Recordset |
0007 | Dim rsBooks_To_Regen As Recordset |
0008 | Dim rsNotes_Archive As Recordset |
0009 | Dim rsTestNote As Recordset |
0010 | Dim rsAuto_Reference_Notes_Actions As Recordset |
0011 | Dim rsCognate_Array As Recordset |
0012 | Dim strQuery As String |
0013 | Dim iUpdates As Long |
0014 | Dim Duration As Single |
0015 | Dim RunStartTime As Date |
0016 | Dim strKeyWord As String |
0017 | Dim iKeyWord_ID As Integer |
0018 | Dim iObject_ID As Integer |
0019 | Dim strObject_Text As String |
0020 | Dim i As Long |
0021 | Dim j As Long |
0022 | Dim k As Long |
0023 | Dim Link_OK As Boolean |
0024 | Dim Own_Text As Boolean |
0025 | Dim In_Footnote As Boolean |
0026 | Dim Note_Tag As String |
0027 | Dim Note_Tag1 As String |
0028 | Dim Note_Tag2 As String |
0029 | Dim The_Word As String |
0030 | Dim The_Word_OK As Boolean |
0031 | Dim Update_Object As Boolean |
0032 | Dim strTestNote As String |
0033 | Dim Updating_Run_Notes As Boolean |
0034 | Dim Updating_Run_Others As Boolean |
0035 | Dim iCounter As Integer |
0036 | Dim strTitle As String |
0037 | Dim Object_Marker As String |
0038 | Dim DirectoryName As String |
0039 | Dim FileName As String |
0040 | Dim TestFile As String |
0041 | Dim fs As Object |
0042 | Dim strHeader As String |
0043 | Dim strFootnote As String |
0044 | Dim Suppress_Reference As Boolean |
0045 | Dim Ignore_Reference As Boolean |
0046 | Dim strQuestion As String |
0047 | Dim Replace_Reference As Boolean |
0048 | Dim Confirming_Flag As String |
0049 | Dim Exclude As Boolean |
0050 | Dim Object_Exclude As Boolean |
0051 | Dim Non_Updating_Regen As Boolean |
0052 | Dim Last_Notes_Updating_Run As Date |
0053 | Dim Last_Others_Updating_Run As Date |
0054 | Dim strCognates As String |
0055 | Dim New_Links_Unprocessed_Notes As Integer |
0056 | Dim New_Links_Unprocessed_Others As Integer |
0057 | Dim Msg_Response |
0058 | Dim Object_Read As Boolean |
0059 | Dim Suppress_Debug_Printing As Boolean |
0060 | Dim strTable As String |
0061 | Dim strMsg As String |
0062 | Dim iCheck_Start As Long |
0063 | Dim iCheck_End As Long |
0064 | Dim Read_only_Flag As String |
0065 | Dim Cognate_Array(20) As Variant |
0066 | Dim Invalid_Cognates As Boolean |
0067 | Dim StopRun As Boolean |
0068 | Dim strTest_Cognate As String |
0069 | Dim iAfter As Integer |
0070 | Dim iBefore As Long |
0071 | Dim iAfter_Max As Integer |
0072 | Dim iBefore_Max As Long |
0073 | Dim iSpace As Integer |
0074 | Dim The_Word_Checker As String |
0075 | 'Flags |
0076 | Dim bool_Already_Linked As Boolean |
0077 | Dim bool_Suppressed As Boolean |
0078 | Dim bool_Accepted As Boolean |
0079 | Dim bool_Ignored As Boolean |
0080 | Dim bool_Quoted_Text As Boolean |
0081 | Dim bool_Footnote As Boolean |
0082 | Dim bool_Check_FN_Quote As Boolean |
0083 | Dim bool_In_Author As Boolean |
0084 | Dim bool_In_HTML_Tag As Boolean |
0085 | Dim bool_Invalid_Cognate As Boolean |
0086 | Dim iQuestions As Integer |
0087 | Dim iMax_Questions As Integer |
0088 | On Error GoTo Error_Found |
0089 | 'Parameter |
0090 | iMax_Questions = 5 |
0091 | iQuestions = 0 |
0092 | If IsMissing(Auto_Local) Then |
0093 | Suppress_Debug_Printing = False |
0094 | Else |
0095 | Suppress_Debug_Printing = Auto_Local |
0096 | End If |
0097 | Set fs = CreateObject("Scripting.FileSystemObject") |
0098 | iUpdates = 0 |
0099 | New_Links_Unprocessed_Notes = 0 |
0100 | New_Links_Unprocessed_Others = 0 |
0101 | Confirming_Flag = "" |
0102 | Read_only_Flag = "No" |
0103 | If automatic_processing = "Yes" Then |
0104 | Non_Updating_Regen = True |
0105 | Else |
0106 | Non_Updating_Regen = False |
0107 | End If |
0108 | strCognates = "" |
0109 | 'Check precisely one Note_Alternates row is selected |
0110 | strQuery = "SELECT Count(Note_Alternates.ID) AS CountOfID FROM Note_Alternates WHERE (((Note_Alternates.[Auto_Link?])=Yes));" |
0111 | Set rsKeyWords = CurrentDb.OpenRecordset(strQuery) |
0112 | rsKeyWords.MoveFirst |
0113 | If rsKeyWords.Fields(0) = 0 Then |
0114 | MsgBox ("No Note_Alternates row selected; exiting Auto_Reference_Notes") |
0115 | Exit Sub |
0116 | Else |
0117 | If rsKeyWords.Fields(0) > 1 Then |
0118 | MsgBox ("More than one Note_Alternates row selected; exiting Auto_Reference_Notes") |
0119 | Exit Sub |
0120 | End If |
0121 | End If |
0122 | Set rsKeyWords = Nothing |
0123 | 'Read the Keywords ... restrict to PID Notes |
0124 | strQuery = "SELECT Note_Alternates_1.Item_Alt_Title, Note_Alternates.ID, Note_Alternates.Item_Title, Note_Alternates_1.[Exclude_Auto_Link?], Note_Alternates.Last_Auto_Link_Notes, Note_Alternates.Last_Auto_Link_Others, Notes.Note_Group FROM (Note_Alternates INNER JOIN Note_Alternates AS Note_Alternates_1 ON Note_Alternates.Item_Title = Note_Alternates_1.Item_Title) INNER JOIN Notes ON Note_Alternates_1.ID = Notes.ID WHERE (((Note_Alternates.[Auto_Link?]) = Yes) And ((Notes.Note_Group) = 1)) ORDER BY Note_Alternates_1.[Exclude_Auto_Link?] DESC , IIf([Note_Alternates_1]![Item_Alt_Title]=[Note_Alternates_1]![Item_Title],0,1), Note_Alternates_1.Item_Alt_Title;" |
0125 | Set rsKeyWords = CurrentDb.OpenRecordset(strQuery) |
0126 | strHeader = "" |
0127 | Do Until rsKeyWords.EOF |
0128 | strKeyWord = rsKeyWords.Fields(0) |
0129 | iKeyWord_ID = rsKeyWords.Fields(1) |
0130 | Exclude = rsKeyWords.Fields(3) |
0131 | Object_Exclude = Exclude |
0132 | If strKeyWord = rsKeyWords.Fields(2) Then |
0133 | If Exclude = False Then |
0134 | strHeader = strKeyWord |
0135 | End If |
0136 | End If |
0137 | If strCognates = "" Then |
0138 | strCognates = "xxxx" |
0139 | Else |
0140 | If strCognates = "xxxx" Then |
0141 | strCognates = """" & strKeyWord & """" |
0142 | Else |
0143 | strCognates = strCognates & ", " & """" & strKeyWord & """" |
0144 | End If |
0145 | If Object_Exclude = True Then |
0146 | strCognates = strCognates & " (excluded)" |
0147 | End If |
0148 | End If |
0149 | rsKeyWords.MoveNext |
0150 | Loop |
0151 | strQuery = "DELETE * FROM Auto_Reference_Notes_Actions WHERE Note_ID = " & iKeyWord_ID & ";" |
0152 | DoCmd.RunSQL (strQuery) |
0153 | Set rsAuto_Reference_Notes_Actions = CurrentDb.OpenRecordset("SELECT * FROM Auto_Reference_Notes_Actions WHERE Note_ID = " & iKeyWord_ID & ";") |
0154 | 'Re-Read the Keywords - but ignore any ending in "?" or those excluded ... again restrict to PID Notes |
0155 | strQuery = "SELECT Note_Alternates_1.Item_Alt_Title, Note_Alternates.ID, Note_Alternates.Item_Title, Note_Alternates_1.[Exclude_Auto_Link?], Note_Alternates.Last_Auto_Link_Notes, Note_Alternates.Last_Auto_Link_Others FROM (Note_Alternates INNER JOIN Note_Alternates AS Note_Alternates_1 ON Note_Alternates.Item_Title = Note_Alternates_1.Item_Title) INNER JOIN Notes ON Note_Alternates_1.ID = Notes.ID WHERE (((Note_Alternates_1.[Exclude_Auto_Link?]) <> Yes) And ((Note_Alternates.[Auto_Link?]) = Yes) And ((Right([Note_Alternates_1].[Item_Alt_Title], 1)) <> ""?"") And ((Notes.Note_Group) = 1)) ORDER BY IIf([Note_Alternates_1]![Item_Alt_Title]=[Note_Alternates_1]![Item_Title],0,1), Note_Alternates_1.Item_Alt_Title;" |
0156 | Set rsKeyWords = CurrentDb.OpenRecordset(strQuery) |
0157 | If rsKeyWords.EOF Then |
0158 | If Non_Updating_Regen = False Then |
0159 | MsgBox ("No links to set!") |
0160 | End |
0161 | Else |
0162 | Exit Sub |
0163 | End If |
0164 | Else |
0165 | rsKeyWords.MoveFirst |
0166 | If rsKeyWords.Fields(4) & "" = "" Then |
0167 | Last_Notes_Updating_Run = 0 |
0168 | Else |
0169 | Last_Notes_Updating_Run = rsKeyWords.Fields(4) |
0170 | End If |
0171 | If rsKeyWords.Fields(5) & "" = "" Then |
0172 | Last_Others_Updating_Run = 0 |
0173 | Else |
0174 | Last_Others_Updating_Run = rsKeyWords.Fields(5) |
0175 | End If |
0176 | End If |
0177 | If strHeader = "" Then |
0178 | strHeader = rsKeyWords.Fields(0) |
0179 | End If |
0180 | If Non_Updating_Regen = False Then |
0181 | If MsgBox("Auto-Reference Notes for " & strHeader & "?", vbYesNo + vbDefaultButton1) <> vbYes Then |
0182 | MsgBox ("Update the ""Note_Alternates"" Table and try again!") |
0183 | End |
0184 | End If |
0185 | If MsgBox(strHeader & ": Updating Run?", vbYesNo + vbDefaultButton2) = vbYes Then |
0186 | If MsgBox("Update Notes?", vbYesNo + vbDefaultButton2) = vbYes Then |
0187 | Updating_Run_Notes = True |
0188 | Else |
0189 | Updating_Run_Notes = False |
0190 | End If |
0191 | If MsgBox("Update Others?", vbYesNo + vbDefaultButton1) = vbYes Then |
0192 | Updating_Run_Others = True |
0193 | Else |
0194 | Updating_Run_Others = False |
0195 | End If |
0196 | If Updating_Run_Notes = True Or Updating_Run_Others = True Then |
0197 | If MsgBox("Confirm links?", vbYesNo) = vbYes Then |
0198 | If MsgBox("Confirm All links?", vbYesNo) = vbYes Then |
0199 | Confirming_Flag = "All" |
0200 | Else |
0201 | If MsgBox("Confirm New links only?", vbYesNo) = vbYes Then |
0202 | Confirming_Flag = "New" |
0203 | Else |
0204 | If MsgBox("Now not confirming links. Is this correct?", vbYesNo) = vbNo Then |
0205 | OK = MsgBox("Exiting ...") |
0206 | Exit Sub |
0207 | End If |
0208 | End If |
0209 | End If |
0210 | If (Updating_Run_Others = True) And (Confirming_Flag <> "") Then |
0211 | If MsgBox("For Books and Papers, query more than half-read items only?", vbYesNo + vbDefaultButton1) = vbYes Then |
0212 | Read_only_Flag = "Yes" |
0213 | Else |
0214 | Read_only_Flag = "No" |
0215 | End If |
0216 | End If |
0217 | End If |
0218 | End If |
0219 | Else |
0220 | Updating_Run_Notes = False |
0221 | Updating_Run_Others = False |
0222 | End If |
0223 | Else |
0224 | Updating_Run_Notes = False |
0225 | Updating_Run_Others = False |
0226 | End If |
0227 | OK = DebugPrint(Suppress_Debug_Printing, "Auto-Reference Note ID = " & iKeyWord_ID & " (" & strKeyWord & ") Updating Notes = " & IIf(Updating_Run_Notes = False, "No", "Yes") & "; Updating Others = " & IIf(Updating_Run_Others = False, "No", "Yes")) |
0228 | automatic_processing = "Yes" |
0229 | strFootnote = "++FN|..|" |
0230 | If Updating_Run_Notes = False Or Updating_Run_Others = False Then |
0231 | strFootnote = strFootnote & "|.|This page was produced after a non-updating run. This might be because it was a test, or simply because it was a re-run after an updating run. " |
0232 | End If |
0233 | strFootnote = strFootnote & "|.|For further comments on methodology, see [this Note]+N1289N+. |..| ++" |
0234 | strTestNote = "[This page]" & strFootnote & " lists those Objects with links to the above Note, including those updated as a result of automatic Cross-Referencing of Notes (some of which may be spurious and require eliminating). Objects are listed by Object Type within Key-Word variant. " |
0235 | strTestNote = strTestNote & "Books and Papers that I've completed reading are marked ""***Read***"", which is a statement rather than a command. Further information on methodology is given above the footnotes below. |II|" |
0236 | RunStartTime = Now() |
0237 | 'Clear the Notes_To_Regen_Temp table ... |
0238 | strQuery = "DELETE * FROM Notes_To_Regen_Temp;" |
0239 | DoCmd.RunSQL (strQuery) |
0240 | 'Copy Notes_To_Regen to Notes_To_Regen_Temp ... |
0241 | strQuery = "INSERT INTO Notes_To_Regen_Temp ( Note_ID, [Timestamp] ) SELECT Notes_To_Regen.Note_ID, Notes_To_Regen.Timestamp FROM Notes_To_Regen;" |
0242 | DoCmd.RunSQL (strQuery) |
0243 | StopRun = False |
0244 | Do Until rsKeyWords.EOF |
0245 | If StopRun = False Then |
0246 | strKeyWord = rsKeyWords.Fields(0) |
0247 | 'Build the Cognate_Exclusions Table ... |
0248 | Set rsCognate_Array = CurrentDb.OpenRecordset("SELECT * FROM Excluded_Cognates WHERE Excluded_Cognates.Key_Word = """ & strKeyWord & """;") |
0249 | If rsCognate_Array.EOF Then |
0250 | Invalid_Cognates = False |
0251 | Else |
0252 | Invalid_Cognates = True |
0253 | rsCognate_Array.MoveFirst |
0254 | i = 1 |
0255 | iAfter_Max = 0 |
0256 | iBefore_Max = 0 |
0257 | Do Until rsCognate_Array.EOF |
0258 | strTest_Cognate = rsCognate_Array.Fields(1) |
0259 | Cognate_Array(i) = strTest_Cognate |
0260 | 'check for spaces |
0261 | iSpace = InStr(strTest_Cognate, " ") |
0262 | If iSpace > 0 Then |
0263 | If InStr(strTest_Cognate, strKeyWord) > iSpace Then |
0264 | iBefore = iSpace |
0265 | If iBefore > iBefore_Max Then |
0266 | iBefore_Max = iBefore |
0267 | End If |
0268 | Else |
0269 | iAfter = Len(strTest_Cognate) |
0270 | If iAfter > iAfter_Max Then |
0271 | iAfter_Max = iAfter |
0272 | End If |
0273 | End If |
0274 | End If |
0275 | rsCognate_Array.MoveNext |
0276 | i = i + 1 |
0277 | Loop |
0278 | End If |
0279 | iKeyWord_ID = rsKeyWords.Fields(1) |
0280 | Exclude = rsKeyWords.Fields(3) |
0281 | 'Object_Exclude = Exclude 'I don't think this is right ... all objects shoud start Excluded, and then accepted |
0282 | Object_Exclude = True |
0283 | strTestNote = strTestNote & "|1|" & strKeyWord & "|..|" |
0284 | 'Read & process the objects - Notes, Author Narratives, Paper Abstracts, Comments, Book Abstracts, Comments, ... |
0285 | For iCounter = 0 To 7 |
0286 | Select Case iCounter |
0287 | Case 0 |
0288 | strQuery = "SELECT Authors.Author_ID, Authors.Author_Name, Authors.Author_Narrative FROM Authors WHERE (((Authors.Author_Narrative) Like ""*" & strKeyWord & "*"")) ORDER BY Authors.Author_Name;" |
0289 | strTitle = "Authors" |
0290 | Object_Marker = "A" |
0291 | Case 1 |
0292 | strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text, Notes.Note_Group, Notes.Status FROM Notes WHERE (((Notes.Item_Text) Like ""*" & strKeyWord & "*"") AND (Notes.Note_Group = 1 OR Notes.Note_Group = 6 OR Notes.Note_Group = 8 OR Notes.Note_Group = 10 OR Notes.Note_Group = 12 OR Notes.Note_Group = 15)) ORDER BY Notes.Item_Title;" 'Only Note_Groups: PID, Write-ups, Animadversions, Supervisions, Religion and Essays |
0293 | strTitle = "Notes" |
0294 | Object_Marker = "+" |
0295 | Case 2 |
0296 | If Read_only_Flag = "No" Then |
0297 | strQuery = "SELECT Papers.ID, Papers.Author, Papers.Abstract, Papers.Title, Papers.[Read?] FROM Papers WHERE (((Papers.Abstract) Like ""*" & strKeyWord & "*"")) ORDER BY Papers.Author, Papers.Title;" |
0298 | Else |
0299 | strQuery = "SELECT Papers.ID, Papers.Author, Papers.Abstract, Papers.Title, Papers.[Read?] FROM Papers WHERE (((Papers.Abstract) Like ""*" & strKeyWord & "*"") AND ((Papers.[Read?])=True)) OR (((Papers.Abstract) Like ""*" & strKeyWord & "*"") AND (([Actual - Total]/[Estimate])>0.5)) ORDER BY Papers.Author, Papers.Title;" |
0300 | End If |
0301 | strTitle = "Paper Abstracts" |
0302 | Object_Marker = "P" |
0303 | Case 3 |
0304 | If Read_only_Flag = "No" Then |
0305 | strQuery = "SELECT Papers.ID, Papers.Author, Papers.Comments, Papers.Title, Papers.[Read?] FROM Papers WHERE (((Papers.Comments) Like ""*" & strKeyWord & "*"")) ORDER BY Papers.Author, Papers.Title;" |
0306 | Else |
0307 | strQuery = "SELECT Papers.ID, Papers.Author, Papers.Comments, Papers.Title, Papers.[Read?] FROM Papers WHERE (((Papers.Comments) Like ""*" & strKeyWord & "*"") AND ((Papers.[Read?])=True)) OR (((Papers.Comments) Like ""*" & strKeyWord & "*"") AND (([Actual - Total]/[Estimate])>0.5)) ORDER BY Papers.Author, Papers.Title;" |
0308 | End If |
0309 | strTitle = "Paper Comments" |
0310 | Object_Marker = "P" |
0311 | Case 4 |
0312 | If Read_only_Flag = "No" Then |
0313 | strQuery = "SELECT Books.ID1, Books.Author, Books.Abstract, Books.Title, Books.[Read?] FROM Books WHERE (((Books.Abstract) Like ""*" & strKeyWord & "*"")) ORDER BY Books.Author, Books.Title;" |
0314 | Else |
0315 | strQuery = "SELECT Books.ID1, Books.Author, Books.Abstract, Books.Title, Books.[Read?] FROM Books WHERE (((Books.Abstract) Like ""*" & strKeyWord & "*"") AND ((Books.[Read?])=True)) OR (((Books.Abstract) Like ""*" & strKeyWord & "*"") AND (([Actual - Total]/[Estimate])>0.5)) ORDER BY Books.Author, Books.Title;" |
0316 | End If |
0317 | strTitle = "Book Abstracts" |
0318 | Object_Marker = "B" |
0319 | Case 5 |
0320 | If Read_only_Flag = "No" Then |
0321 | strQuery = "SELECT Books.ID1, Books.Author, Books.Comments, Books.Title, Books.[Read?] FROM Books WHERE (((Books.Comments) Like ""*" & strKeyWord & "*"")) ORDER BY Books.Author, Books.Title;" |
0322 | Else |
0323 | strQuery = "SELECT Books.ID1, Books.Author, Books.Comments, Books.Title, Books.[Read?] FROM Books WHERE (((Books.Comments) Like ""*" & strKeyWord & "*"") AND ((Books.[Read?])=True)) OR (((Books.Comments) Like ""*" & strKeyWord & "*"") AND (([Actual - Total]/[Estimate])>0.5)) ORDER BY Books.Author, Books.Title;" |
0324 | End If |
0325 | strTitle = "Book Comments" |
0326 | Object_Marker = "B" |
0327 | Case 6 |
0328 | strQuery = "SELECT Books.ID1, Books.Author, Books.Title, Books.Abstract, Books.[Read?], Books.Comments FROM Books WHERE ((Books.Title) Like ""*" & strKeyWord & "*"") ORDER BY Books.Author, Books.Title;" |
0329 | strTitle = "Book Title" |
0330 | Object_Marker = "B" |
0331 | Case 7 |
0332 | strQuery = "SELECT Papers.ID, Papers.Author, Papers.Title, Papers.Abstract, Papers.[Read?], Papers.Comments FROM Papers WHERE ((Papers.Title) Like ""*" & strKeyWord & "*"") ORDER BY Papers.Author, Papers.Title;" |
0333 | strTitle = "Paper Title" |
0334 | Object_Marker = "P" |
0335 | End Select |
0336 | Set rsObject = CurrentDb.OpenRecordset(strQuery) |
0337 | If Not rsObject.EOF Then |
0338 | strTestNote = strTestNote & "|.|" & strTitle & "|99|" |
0339 | rsObject.MoveFirst |
0340 | iObject_ID = rsObject.Fields(0) |
0341 | If Object_Marker = "B" Or Object_Marker = "P" Then |
0342 | Object_Read = rsObject.Fields(4) |
0343 | Else |
0344 | Object_Read = False |
0345 | End If |
0346 | Do Until rsObject.EOF |
0347 | bool_Already_Linked = False |
0348 | bool_Suppressed = False |
0349 | bool_Accepted = False |
0350 | bool_Ignored = False |
0351 | bool_Quoted_Text = False |
0352 | bool_Footnote = False |
0353 | bool_Check_FN_Quote = False |
0354 | bool_In_Author = False |
0355 | bool_In_HTML_Tag = False |
0356 | bool_Invalid_Cognate = False |
0357 | If iCounter = 1 And ((iObject_ID = iKeyWord_ID) Or (iObject_ID = 1292) Or (iObject_ID = 874)) Then 'Ignore the Notes for the KeyWord itself, the Note used for this process and the Aeon Note |
0358 | Else |
0359 | If iCounter > 5 Then |
0360 | 'Book / Paper Titles |
0361 | 'Need to check for excluded Cognates |
0362 | If Invalid_Cognates = True Then |
0363 | OK = Spot_Invalid_Cognates(rsObject.Fields(2), Cognate_Array()) |
0364 | Else |
0365 | OK = "OK" |
0366 | End If |
0367 | If OK <> "OK" Then |
0368 | Ignore_Reference = True |
0369 | The_Word_OK = False |
0370 | bool_Invalid_Cognate = True |
0371 | Else |
0372 | Suppress_Reference = False |
0373 | Object_Exclude = False |
0374 | End If |
0375 | 'Output Auto_Reference_Notes_Actions row for Book or Paper Titles |
0376 | rsAuto_Reference_Notes_Actions.AddNew |
0377 | rsAuto_Reference_Notes_Actions.Fields(0) = iKeyWord_ID |
0378 | rsAuto_Reference_Notes_Actions.Fields(1) = strKeyWord |
0379 | rsAuto_Reference_Notes_Actions.Fields(2) = strTitle |
0380 | rsAuto_Reference_Notes_Actions.Fields(3) = iObject_ID |
0381 | rsAuto_Reference_Notes_Actions.Fields(4) = "" |
0382 | rsAuto_Reference_Notes_Actions.Fields(5) = 0 |
0383 | rsAuto_Reference_Notes_Actions.Fields(6) = Now() |
0384 | rsAuto_Reference_Notes_Actions.Fields(7) = False |
0385 | rsAuto_Reference_Notes_Actions.Fields(8) = False |
0386 | rsAuto_Reference_Notes_Actions.Fields(9) = False |
0387 | rsAuto_Reference_Notes_Actions.Fields(10) = False |
0388 | rsAuto_Reference_Notes_Actions.Fields(11) = False |
0389 | rsAuto_Reference_Notes_Actions.Fields(12) = False |
0390 | rsAuto_Reference_Notes_Actions.Fields(13) = False |
0391 | rsAuto_Reference_Notes_Actions.Fields(14) = False |
0392 | rsAuto_Reference_Notes_Actions.Fields(15) = bool_Invalid_Cognate |
0393 | rsAuto_Reference_Notes_Actions.Update |
0394 | Else |
0395 | iObject_ID = rsObject.Fields(0) |
0396 | strObject_Text = rsObject.Fields(2) |
0397 | Update_Object = False |
0398 | 'Find the next strKeyWord |
0399 | i = 1 |
0400 | Link_OK = False |
0401 | 'This is the loop that interrogates a particular object |
0402 | 'Meaning of flags: Note that some flags apply to the Object, and some only to a particular reference in the Object |
0403 | '... Link_OK: False if the Reference is rejected, or there are no more references in the Object |
0404 | '... The_Word_OK: Says whether the word found is free of tags - namely brackets or + signs. If it is tagged, we won't be able to tag it again, but the Object ought still to be selectable ... |
0405 | '... Suppress_Reference: Relates to +XX+. ie. explicit suppression of a reference |
0406 | '... Object_Exclude: |
0407 | '... Update_Object: set if we've |
0408 | '************************************************************************* |
0409 | Do Until i = 0 |
0410 | bool_Already_Linked = False |
0411 | bool_Suppressed = False |
0412 | bool_Accepted = False |
0413 | bool_Ignored = False |
0414 | bool_Quoted_Text = False |
0415 | bool_Footnote = False |
0416 | bool_Check_FN_Quote = False |
0417 | bool_Invalid_Cognate = False |
0418 | bool_In_Author = False |
0419 | bool_In_HTML_Tag = False |
0420 | i = InStr(i, strObject_Text, strKeyWord) |
0421 | The_Word_Checker = "" |
0422 | If i > 0 Then |
0423 | Link_OK = True |
0424 | i = i + 2 |
0425 | Else |
0426 | Link_OK = False |
0427 | End If |
0428 | If Link_OK = True Then |
0429 | j = FindWordEnd(strObject_Text, i + Len(strKeyWord) - 2, "]") |
0430 | If WordFound = "Yes" Then '"WordFound" is a global variable set in FindWordEnd |
0431 | The_Word_OK = True |
0432 | Else |
0433 | The_Word_OK = False |
0434 | End If |
0435 | k = FindWord(strObject_Text, i) 'Find Start of word (may be pre-fixed) |
0436 | If k > 1 Then |
0437 | 'Check no Bracket at start ... if so, probably already bagged! [Ie. already has tags] |
0438 | If Mid(strObject_Text, k, 1) = "[" Then |
0439 | The_Word_OK = False |
0440 | End If |
0441 | End If |
0442 | Suppress_Reference = False |
0443 | Replace_Reference = False |
0444 | Ignore_Reference = False |
0445 | End If |
0446 | If Link_OK = True Then |
0447 | 'Check for Author's name ... |
0448 | If k > 20 Then |
0449 | iCheck_Start = k - 20 |
0450 | Else |
0451 | iCheck_Start = 1 |
0452 | End If |
0453 | iCheck_End = j + 20 |
0454 | OK = Check_If_In_Container(strObject_Text, "+A", (j + k) / 2, "A+", iCheck_Start, iCheck_End) |
0455 | If OK <> "No" Then 'In an Author Name |
0456 | bool_In_Author = True |
0457 | Link_OK = False |
0458 | The_Word = Mid(strObject_Text, k, j - k) |
0459 | End If |
0460 | 'Check if in HTML Tag ... |
0461 | If k > 40 Then |
0462 | iCheck_Start = k - 40 |
0463 | Else |
0464 | iCheck_Start = 1 |
0465 | End If |
0466 | iCheck_End = j + 40 |
0467 | OK = Check_If_In_Container(strObject_Text, "", iCheck_Start, iCheck_End) |
0468 | If OK <> "No" Then 'In an Author Name |
0469 | bool_In_HTML_Tag = True |
0470 | Link_OK = False |
0471 | The_Word = Mid(strObject_Text, k, j - k) |
0472 | End If |
0473 | End If |
0474 | If Link_OK = True Then |
0475 | If The_Word_OK = True Then 'Ie. the Word has no tags already |
0476 | The_Word = Mid(strObject_Text, k, j - k) |
0477 | 'Need to check for excluded Cognates |
0478 | If Invalid_Cognates = True Then |
0479 | If j - k < iAfter_Max Then |
0480 | iAfter = iAfter_Max |
0481 | Else |
0482 | iAfter = j - k |
0483 | End If |
0484 | If iBefore_Max > 0 Then |
0485 | If k > iBefore_Max Then |
0486 | iBefore = k - iBefore_Max |
0487 | Else |
0488 | iBefore = 1 |
0489 | End If |
0490 | Else |
0491 | iBefore = k |
0492 | End If |
0493 | The_Word_Checker = Mid(strObject_Text, iBefore, j - iBefore + iAfter) |
0494 | OK = Spot_Invalid_Cognates(The_Word_Checker, Cognate_Array()) |
0495 | Else |
0496 | OK = "OK" |
0497 | End If |
0498 | If OK <> "OK" Then |
0499 | Link_OK = False |
0500 | bool_Invalid_Cognate = True |
0501 | The_Word_OK = False |
0502 | Else |
0503 | If Confirming_Flag = "All" Or Confirming_Flag = "New" Then |
0504 | 'Ask if we want this link |
0505 | If k > 100 Then |
0506 | strQuestion = Mid(strObject_Text, k - 100, 200) |
0507 | Else |
0508 | strQuestion = Left(strObject_Text, 200) |
0509 | End If |
0510 | strQuestion = strKeyWord & ": Accept this link?""... " & Chr$(10) & strTitle & ": " & iObject_ID & " : " & rsObject.Fields(1) & Chr$(10) & strQuestion & "...""" |
0511 | If (iCounter = 1 And Updating_Run_Notes = True) Or (iCounter <> 1 And Updating_Run_Others = True) Then |
0512 | Msg_Response = MsgBox(strQuestion, vbYesNoCancel + vbDefaultButton1) |
0513 | Select Case Msg_Response |
0514 | Case vbNo |
0515 | Suppress_Reference = True |
0516 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; To be suppressed") |
0517 | bool_Suppressed = True |
0518 | Case vbYes |
0519 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Accepted") |
0520 | bool_Accepted = True |
0521 | Object_Exclude = False |
0522 | Case vbCancel |
0523 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Ignored") |
0524 | Ignore_Reference = True |
0525 | bool_Ignored = True |
0526 | End Select |
0527 | Else |
0528 | Object_Exclude = False |
0529 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Listed") |
0530 | If iCounter = 1 Then |
0531 | New_Links_Unprocessed_Notes = New_Links_Unprocessed_Notes + 1 |
0532 | Else |
0533 | New_Links_Unprocessed_Others = New_Links_Unprocessed_Others + 1 |
0534 | End If |
0535 | End If |
0536 | Else |
0537 | Object_Exclude = False |
0538 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Listed") |
0539 | If iCounter = 1 Then |
0540 | New_Links_Unprocessed_Notes = New_Links_Unprocessed_Notes + 1 |
0541 | Else |
0542 | New_Links_Unprocessed_Others = New_Links_Unprocessed_Others + 1 |
0543 | End If |
0544 | End If |
0545 | End If |
0546 | Else |
0547 | 'The word has tags '*********************************** |
0548 | The_Word = Mid(strObject_Text, k, j - k + 4) |
0549 | 'First check if excluded Cognate ... |
0550 | If Invalid_Cognates = True Then |
0551 | If j - k < iAfter_Max Then |
0552 | iAfter = iAfter_Max |
0553 | Else |
0554 | iAfter = j - k |
0555 | End If |
0556 | If iBefore_Max > 0 Then |
0557 | If k > iBefore_Max Then |
0558 | iBefore = k - iBefore_Max |
0559 | Else |
0560 | iBefore = 1 |
0561 | End If |
0562 | Else |
0563 | iBefore = k |
0564 | End If |
0565 | The_Word_Checker = Mid(strObject_Text, iBefore, j - iBefore + iAfter + 4) 'This isn't really necessary as far as "after" is concerned |
0566 | OK = Spot_Invalid_Cognates(The_Word_Checker, Cognate_Array()) |
0567 | Else |
0568 | OK = "OK" |
0569 | End If |
0570 | If OK <> "OK" Then |
0571 | Link_OK = False |
0572 | bool_Invalid_Cognate = True |
0573 | Else |
0574 | If Right(The_Word, 4) = "+XX+" Then |
0575 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Suppressed Reference") |
0576 | Suppress_Reference = True |
0577 | bool_Suppressed = True |
0578 | bool_Check_FN_Quote = True |
0579 | Else |
0580 | If Confirming_Flag = "All" Then |
0581 | 'Ask if we want to suppress this link |
0582 | Note_Tag1 = "+N" & iKeyWord_ID & "N+" |
0583 | Note_Tag2 = "++" & iKeyWord_ID & "++" |
0584 | If InStr(The_Word, " ") > 0 Then |
0585 | Note_Tag1 = "]" & Note_Tag1 |
0586 | Note_Tag2 = "]" & Note_Tag2 |
0587 | End If |
0588 | If (Mid(strObject_Text, j, Len(Note_Tag1)) = Note_Tag1) Or (Mid(strObject_Text, j, Len(Note_Tag2)) = Note_Tag2) Then |
0589 | 'But don't ask if link isn't of the right form |
0590 | If k > 100 Then |
0591 | strQuestion = Mid(strObject_Text, k - 100, 200) |
0592 | Else |
0593 | strQuestion = Left(strObject_Text, 200) |
0594 | End If |
0595 | strQuestion = strKeyWord & ": Remove & Suppress this link?""... " & Chr$(10) & strTitle & ": " & iObject_ID & " : " & rsObject.Fields(1) & Chr$(10) & strQuestion & "...""" |
0596 | If (iCounter = 1 And Updating_Run_Notes = True) Or (iCounter <> 1 And Updating_Run_Others = True) Then |
0597 | If MsgBox(strQuestion, vbYesNo + vbDefaultButton2) = vbYes Then |
0598 | Suppress_Reference = True |
0599 | Replace_Reference = True |
0600 | The_Word_OK = True |
0601 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Existing link To be suppressed") |
0602 | bool_Suppressed = True |
0603 | bool_Check_FN_Quote = True |
0604 | Else |
0605 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Existing link Accepted") |
0606 | Object_Exclude = False |
0607 | bool_Accepted = True |
0608 | bool_Check_FN_Quote = True |
0609 | End If |
0610 | Else |
0611 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Already linked") |
0612 | Object_Exclude = False |
0613 | bool_Already_Linked = True |
0614 | End If |
0615 | Else |
0616 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Already linked") |
0617 | Object_Exclude = False |
0618 | bool_Already_Linked = True |
0619 | bool_Check_FN_Quote = True |
0620 | End If |
0621 | Else |
0622 | If j - k < iAfter_Max Then |
0623 | iAfter = iAfter_Max |
0624 | Else |
0625 | iAfter = j - k |
0626 | End If |
0627 | If iBefore_Max > 0 Then |
0628 | If k > iBefore_Max Then |
0629 | iBefore = k - iBefore_Max |
0630 | Else |
0631 | iBefore = 1 |
0632 | End If |
0633 | Else |
0634 | iBefore = k |
0635 | End If |
0636 | The_Word_Checker = Mid(strObject_Text, iBefore, j - iBefore + iAfter) |
0637 | OK = Spot_Invalid_Cognates(The_Word_Checker, Cognate_Array()) |
0638 | If OK = "OK" Then |
0639 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Already linked") |
0640 | bool_Already_Linked = True |
0641 | bool_Check_FN_Quote = True |
0642 | Object_Exclude = False |
0643 | Else |
0644 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; Already linked, but Invalid Cognate") |
0645 | bool_Already_Linked = True |
0646 | bool_Invalid_Cognate = True |
0647 | bool_Check_FN_Quote = False |
0648 | End If |
0649 | End If |
0650 | End If |
0651 | 'End of checking tagged word... **************************** |
0652 | End If |
0653 | End If |
0654 | If bool_Invalid_Cognate = False Then |
0655 | If The_Word_OK = False And bool_Check_FN_Quote = True Then |
0656 | OK = Check_If_In_Container(strObject_Text, "|Colour_2|", (j + k) / 2, "|Colour_R|") |
0657 | If OK <> "No" Then 'In a quotation |
0658 | bool_Quoted_Text = True |
0659 | End If |
0660 | OK = Check_If_In_Container(strObject_Text, "++FN", (j + k) / 2, "++") |
0661 | If OK <> "No" Then 'In a footnote |
0662 | bool_Footnote = True |
0663 | End If |
0664 | End If |
0665 | If The_Word_OK = True Then |
0666 | 'Check if in quoted text |
0667 | OK = Check_If_In_Container(strObject_Text, "|Colour_2|", (j + k) / 2, "|Colour_R|") |
0668 | If OK <> "No" Then 'In a quotation |
0669 | Own_Text = False |
0670 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; In quoted text") |
0671 | bool_Quoted_Text = True |
0672 | Else |
0673 | Own_Text = True |
0674 | End If |
0675 | 'Find if in Footnote |
0676 | In_Footnote = False |
0677 | OK = Check_If_In_Container(strObject_Text, "++FN", (j + k) / 2, "++") |
0678 | If OK <> "No" Then 'In a footnote |
0679 | In_Footnote = True |
0680 | OK = DebugPrint(Suppress_Debug_Printing, strTitle & "; " & iObject_ID & "; " & The_Word & "; " & k & "; In Footnote") |
0681 | bool_Footnote = True |
0682 | Else |
0683 | In_Footnote = False |
0684 | End If |
0685 | If (In_Footnote = True) Or (iCounter = 5) Then 'Book comments require +NnnnN+ format |
0686 | 'Add +NnnnN+ |
0687 | Note_Tag = "+N" & iKeyWord_ID & "N+" |
0688 | Else |
0689 | 'Add ++nnn++ |
0690 | Note_Tag = "++" & iKeyWord_ID & "++" |
0691 | End If |
0692 | End If |
0693 | If The_Word_OK = True Then |
0694 | If iCounter = 1 And Updating_Run_Notes = True Then 'Notes only! Write out to Notes_To_Regen_Temp if it doesn't already exist |
0695 | strQuery = "SELECT * FROM Notes_To_Regen_Temp WHERE Note_ID=" & iObject_ID & ";" |
0696 | Set rsNotes_To_Regen_Temp = CurrentDb.OpenRecordset(strQuery) |
0697 | If rsNotes_To_Regen_Temp.EOF Then |
0698 | rsNotes_To_Regen_Temp.AddNew |
0699 | rsNotes_To_Regen_Temp.Fields(0) = iObject_ID |
0700 | rsNotes_To_Regen_Temp.Fields(1) = Now() |
0701 | rsNotes_To_Regen_Temp.Update |
0702 | End If |
0703 | End If |
0704 | If (iCounter = 4 Or iCounter = 5) And Updating_Run_Others = True Then 'Books only! |
0705 | strQuery = "SELECT * FROM Books_To_Regen WHERE Book_ID=" & iObject_ID & ";" |
0706 | Set rsBooks_To_Regen = CurrentDb.OpenRecordset(strQuery) |
0707 | If rsBooks_To_Regen.EOF Then |
0708 | rsBooks_To_Regen.AddNew |
0709 | rsBooks_To_Regen.Fields(0) = iObject_ID |
0710 | rsBooks_To_Regen.Update |
0711 | End If |
0712 | End If |
0713 | 'Update the Text (but not, yet, the actual object |
0714 | Update_Object = True |
0715 | If Suppress_Reference = True Then |
0716 | If Replace_Reference = True Then |
0717 | 'Need to remove brackets ... TO BE SUPPLIED! |
0718 | If InStr(The_Word, " ") > 0 Then |
0719 | 'Need to remove brackets |
0720 | If k > 5 Then |
0721 | OK = DebugPrint(Suppress_Debug_Printing, Mid(strObject_Text, k, j - k + 20)) |
0722 | strObject_Text = Left(strObject_Text, k - 5) & Replace(Replace(Mid(strObject_Text, k - 4, j - k + 5), "[", ""), "]", "") & Mid(strObject_Text, j + 1) |
0723 | OK = DebugPrint(Suppress_Debug_Printing, Mid(strObject_Text, k, j - k + 20)) |
0724 | Else |
0725 | OK = DebugPrint(Suppress_Debug_Printing, Left(strObject_Text, j + 20)) |
0726 | strObject_Text = Replace(Replace(Left(strObject_Text, j + 1) & Mid(strObject_Text, j + 2), "[", ""), "]", "") |
0727 | OK = DebugPrint(Suppress_Debug_Printing, Left(strObject_Text, j + 20)) |
0728 | End If |
0729 | j = j - 1 |
0730 | End If |
0731 | strObject_Text = Left(strObject_Text, j - 1) & "+XX+" & Mid(strObject_Text, j + Len(Note_Tag)) |
0732 | OK = DebugPrint(Suppress_Debug_Printing, Mid(strObject_Text, k, j - k + 20)) |
0733 | Else |
0734 | strObject_Text = Left(strObject_Text, j - 1) & "+XX+" & Mid(strObject_Text, j) |
0735 | End If |
0736 | Else |
0737 | If Ignore_Reference = False Then |
0738 | If InStr(The_Word, " ") > 0 Then |
0739 | 'Need to bracket the KeyWord |
0740 | Note_Tag = "[" & The_Word & "]" & Note_Tag |
0741 | strObject_Text = Left(strObject_Text, k - 1) & Note_Tag & Mid(strObject_Text, j) |
0742 | i = i + 1 |
0743 | Else |
0744 | strObject_Text = Left(strObject_Text, j - 1) & Note_Tag & Mid(strObject_Text, j) |
0745 | End If |
0746 | End If |
0747 | End If |
0748 | iUpdates = iUpdates + 1 |
0749 | End If |
0750 | End If |
0751 | End If |
0752 | If i > 0 Then |
0753 | If The_Word_Checker = "" Then |
0754 | The_Word_Checker = The_Word |
0755 | End If |
0756 | On Error Resume Next 'Fudge ... |
0757 | 'Output Auto_Reference_Notes_Actions row |
0758 | rsAuto_Reference_Notes_Actions.AddNew |
0759 | rsAuto_Reference_Notes_Actions.Fields(0) = iKeyWord_ID |
0760 | rsAuto_Reference_Notes_Actions.Fields(1) = strKeyWord |
0761 | rsAuto_Reference_Notes_Actions.Fields(2) = strTitle |
0762 | rsAuto_Reference_Notes_Actions.Fields(3) = iObject_ID |
0763 | rsAuto_Reference_Notes_Actions.Fields(4) = The_Word_Checker |
0764 | rsAuto_Reference_Notes_Actions.Fields(5) = k |
0765 | rsAuto_Reference_Notes_Actions.Fields(6) = Now() |
0766 | rsAuto_Reference_Notes_Actions.Fields(7) = bool_Already_Linked |
0767 | rsAuto_Reference_Notes_Actions.Fields(8) = bool_Suppressed |
0768 | rsAuto_Reference_Notes_Actions.Fields(9) = bool_Accepted |
0769 | rsAuto_Reference_Notes_Actions.Fields(10) = bool_Ignored |
0770 | rsAuto_Reference_Notes_Actions.Fields(11) = bool_Quoted_Text |
0771 | rsAuto_Reference_Notes_Actions.Fields(12) = bool_Footnote |
0772 | rsAuto_Reference_Notes_Actions.Fields(13) = bool_In_Author |
0773 | rsAuto_Reference_Notes_Actions.Fields(14) = bool_In_HTML_Tag |
0774 | rsAuto_Reference_Notes_Actions.Fields(15) = bool_Invalid_Cognate |
0775 | rsAuto_Reference_Notes_Actions.Update |
0776 | On Error GoTo Error_Found |
0777 | End If |
0778 | Loop |
0779 | 'End of the loop to interrogate a particular Object |
0780 | '************************************************************************************ |
0781 | End If |
0782 | 'Update the Test Note |
0783 | If Suppress_Reference = False And Object_Exclude = False Then |
0784 | Select Case iCounter |
0785 | Case 0 'Authors |
0786 | strTestNote = strTestNote & "|1|+" & Object_Marker & rsObject.Fields(1) & Object_Marker & "+" |
0787 | Case 1 'Notes |
0788 | strTestNote = strTestNote & "|1|[" & rsObject.Fields(1) & "]++" & iObject_ID & "++" |
0789 | Case Else |
0790 | strTestNote = strTestNote & "|1|+" & Object_Marker & iObject_ID & Object_Marker & "+" |
0791 | If Object_Read = True Then |
0792 | strTestNote = strTestNote & " ***Read***" |
0793 | End If |
0794 | End Select |
0795 | End If |
0796 | If Update_Object = True And Exclude = False Then |
0797 | 'Update the Object |
0798 | If (iCounter = 1 And Updating_Run_Notes = True) Then |
0799 | rsObject.Edit |
0800 | rsObject.Fields(2) = strObject_Text |
0801 | rsObject.Update |
0802 | If rsObject.Fields(4) & "" <> "Temp" Then |
0803 | 'Need to update the latest Archive Note as well, to stop creating a needless Archive |
0804 | strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Timestamp, Notes_Archive.Item_Text FROM Notes_Archive WHERE (((Notes_Archive.ID) = " & iObject_ID & ")) ORDER BY Notes_Archive.Timestamp DESC;" |
0805 | Set rsNotes_Archive = CurrentDb.OpenRecordset(strQuery) |
0806 | If Not rsNotes_Archive.EOF Then |
0807 | rsNotes_Archive.MoveFirst |
0808 | rsNotes_Archive.Edit |
0809 | rsNotes_Archive.Fields(2) = strObject_Text |
0810 | rsNotes_Archive.Update |
0811 | End If |
0812 | Set rsNotes_Archive = Nothing |
0813 | End If |
0814 | End If |
0815 | If ((iCounter = 0 Or (iCounter > 1 And iCounter < 6)) And Updating_Run_Others = True) Then |
0816 | rsObject.Edit |
0817 | rsObject.Fields(2) = strObject_Text |
0818 | rsObject.Update |
0819 | End If |
0820 | End If |
0821 | End If |
0822 | 'Check if we want to continue |
0823 | StopRun = False |
0824 | If strQuestion & "" <> "" Then |
0825 | If (iCounter = 1 And Updating_Run_Notes = True) Or (iCounter <> 1 And Updating_Run_Others = True) Then |
0826 | iQuestions = iQuestions + 1 |
0827 | If iQuestions > iMax_Questions Then |
0828 | strQuestion = "Maximum of " & iMax_Questions & " exceeded. Continue for another " & iMax_Questions & " questions (Reply ""Yes"")" & " or terminate? (Reply ""No"")" |
0829 | Msg_Response = MsgBox(strQuestion, vbYesNo + vbDefaultButton1) |
0830 | If Msg_Response = vbNo Then |
0831 | rsObject.MoveLast |
0832 | StopRun = True |
0833 | iCounter = 8 |
0834 | Else |
0835 | iQuestions = 0 |
0836 | End If |
0837 | End If |
0838 | End If |
0839 | End If |
0840 | strQuestion = "" |
0841 | rsObject.MoveNext |
0842 | 'Object_Exclude = Exclude 'I don't think this is correct ... all objects should be set to "exclude" until accepted |
0843 | Object_Exclude = True |
0844 | If Not rsObject.EOF Then |
0845 | iObject_ID = rsObject.Fields(0) |
0846 | If Object_Marker = "B" Or Object_Marker = "P" Then |
0847 | Object_Read = rsObject.Fields(4) |
0848 | Else |
0849 | Object_Read = False |
0850 | End If |
0851 | End If |
0852 | Loop |
0853 | 'Update the Test Note |
0854 | strTestNote = strTestNote & "|99|" |
0855 | End If |
0856 | Next iCounter |
0857 | End If |
0858 | strTestNote = strTestNote & "|..|" |
0859 | 'Update last run date for this key-word |
0860 | strQuery = "SELECT Note_Alternates.Last_Auto_Link_Run, Note_Alternates.Last_Auto_Link_Notes, Note_Alternates.Last_Auto_Link_Others, Note_Alternates.New_Links_Unprocessed_Notes, Note_Alternates.New_Links_Unprocessed_Other FROM Note_Alternates WHERE (((Note_Alternates.ID)=" & iKeyWord_ID & ") AND ((Note_Alternates.Item_Alt_Title)=[Note_Alternates]![Item_Title]));" |
0861 | Set rsKeyWords_Update = CurrentDb.OpenRecordset(strQuery) |
0862 | rsKeyWords_Update.MoveFirst |
0863 | rsKeyWords_Update.Edit |
0864 | rsKeyWords_Update.Fields(0) = Now() |
0865 | If Updating_Run_Notes = True Then |
0866 | rsKeyWords_Update.Fields(1) = Now() |
0867 | End If |
0868 | If Updating_Run_Others = True Then |
0869 | rsKeyWords_Update.Fields(2) = Now() |
0870 | End If |
0871 | rsKeyWords_Update.Fields(3) = New_Links_Unprocessed_Notes |
0872 | rsKeyWords_Update.Fields(4) = New_Links_Unprocessed_Others |
0873 | rsKeyWords_Update.Update |
0874 | 'Next Key Word |
0875 | If StopRun = True Then |
0876 | rsKeyWords.MoveLast |
0877 | End If |
0878 | rsKeyWords.MoveNext |
0879 | Set rsCognate_Array = Nothing |
0880 | If Invalid_Cognates = True Then |
0881 | For i = LBound(Cognate_Array) To UBound(Cognate_Array) |
0882 | Cognate_Array(i) = Null |
0883 | Next i |
0884 | End If |
0885 | Loop |
0886 | 'Update the Test Note |
0887 | If strCognates = "xxxx" Then |
0888 | strCognates = "" |
0889 | End If |
0890 | strTestNote = "[" & strHeader & "]++++" & IIf(strCognates = "", "", "(Cognates: " & strCognates & ")") & "(Links Page)" & strTestNote & "|II|" |
0891 | 'Add the dates ... |
0892 | strTestNote = strTestNote & "
Latest update for Notes: " & IIf(rsKeyWords_Update.Fields(1) & "" = "", "None", rsKeyWords_Update.Fields(1)) & " " |
0893 | strTestNote = strTestNote & " Latest update for Other Objects: " & IIf(rsKeyWords_Update.Fields(2) & "" = "", "None", rsKeyWords_Update.Fields(2)) & " " |
0894 | 'Add the Auto_Ref_Notes_Stats_Summary & Auto_Ref_Notes_Stats_Detailed tables of usage |
0895 | strTestNote = strTestNote & "
Summary of Key Words Found " |
0896 | OK = Functor_21(4, strTable) |
0897 | strTestNote = strTestNote & strTable & "
Detailed Summary of Key Words Found " |
0898 | OK = Functor_21(5, strTable) |
0899 | strTestNote = strTestNote & strTable |
0900 | 'Update the Test Note |
0901 | strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Note_Group, Notes.Status, Notes.Item_Text FROM Notes WHERE Notes.ID = 874;" |
0902 | Set rsTestNote = CurrentDb.OpenRecordset(strQuery) |
0903 | rsTestNote.MoveFirst |
0904 | rsTestNote.Edit |
0905 | rsTestNote.Fields(3) = "Temp" |
0906 | rsTestNote.Fields(4) = strTestNote |
0907 | rsTestNote.Update |
0908 | Set rsNotes_To_Regen = Nothing |
0909 | 'Output the Test Note |
0910 | strQuery = "DELETE * FROM Notes_To_Regen;" |
0911 | DoCmd.RunSQL (strQuery) |
0912 | strQuery = "SELECT * FROM Notes_To_Regen;" |
0913 | Set rsNotes_To_Regen = CurrentDb.OpenRecordset(strQuery) |
0914 | rsNotes_To_Regen.AddNew |
0915 | rsNotes_To_Regen.Fields(0) = 874 |
0916 | rsNotes_To_Regen.Fields(1) = Now() |
0917 | rsNotes_To_Regen.Update |
0918 | Archive_Notes_Now = "No" |
0919 | Regenerate_the_Links = "No" |
0920 | Regen_Notes_Only = "Yes" |
0921 | CreateNotesWebPages |
0922 | TestFile = TheoWebsiteRoot & "\Notes\Notes_8\Notes_874.htm" |
0923 | strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Note_Group, Notes.Status, Notes.Item_Text FROM Notes WHERE Notes.ID = " & iKeyWord_ID & ";" |
0924 | Set rsObject = CurrentDb.OpenRecordset(strQuery) |
0925 | rsObject.MoveFirst |
0926 | DirectoryName = TheoWebsiteRoot & "\" |
0927 | If rsObject.Fields(2) = 10 Then 'Supervisions |
0928 | DirectoryName = DirectoryName & "Secure_Jen\" |
0929 | Else |
0930 | DirectoryName = DirectoryName & "Notes\" |
0931 | End If |
0932 | DirectoryName = DirectoryName & "Notes_" & Val(Mid(iKeyWord_ID + 10000, 2, 2)) & "\" |
0933 | FileName = "Notes_" & iKeyWord_ID & "_Links.htm" |
0934 | 'Copy the Test Note to the relevant Notes directory |
0935 | If Dir(DirectoryName & FileName) <> "" Then 'If we already have a file in the transfer directory, then zap it |
0936 | Kill DirectoryName & FileName |
0937 | End If |
0938 | fs.CopyFile TestFile, DirectoryName & FileName |
0939 | 'Copy to Transfer |
0940 | OK = CopyToTransfer(DirectoryName, FileName) |
0941 | 'Clear the Notes_To_Regen table ... |
0942 | strQuery = "DELETE * FROM Notes_To_Regen;" |
0943 | DoCmd.RunSQL (strQuery) |
0944 | 'Copy Notes_To_Regen_Temp to Notes_To_Regen ... |
0945 | strQuery = "INSERT INTO Notes_To_Regen ( Note_ID, [Timestamp] ) SELECT Notes_To_Regen_Temp.Note_ID, Notes_To_Regen_Temp.Timestamp FROM Notes_To_Regen_Temp;" |
0946 | DoCmd.RunSQL (strQuery) |
0947 | 'Tidy Up |
0948 | Set rsKeyWords = Nothing |
0949 | Set rsObject = Nothing |
0950 | Set rsNotes_To_Regen = Nothing |
0951 | Set rsNotes_To_Regen_Temp = Nothing |
0952 | Set rsBooks_To_Regen = Nothing |
0953 | Set rsTestNote = Nothing |
0954 | Set rsKeyWords_Update = Nothing |
0955 | Set rsAuto_Reference_Notes_Actions = Nothing |
0956 | Set rsCognate_Array = Nothing |
0957 | Set fs = Nothing |
0958 | OK = DebugPrint(Suppress_Debug_Printing, iUpdates & " changes made for KeyWord = " & strKeyWord & ".") |
0959 | If Non_Updating_Regen = False Then |
0960 | Duration = Round((Now() - RunStartTime) * 24 * 60, 1) |
0961 | strMsg = Now() & " - Automatic Note Linkages Completed in " |
0962 | If Duration < 1 Then |
0963 | Duration = Round((Now() - RunStartTime) * 24 * 60 * 60) |
0964 | strMsg = strMsg & Duration & " seconds. " |
0965 | Else |
0966 | strMsg = strMsg & Duration & " minutes. " |
0967 | End If |
0968 | strMsg = strMsg & iUpdates & " changes made." |
0969 | Debug.Print strMsg |
0970 | MsgBox strMsg, vbOKOnly, "Automatic Note Linkages" |
0971 | End If |
0972 | Exit Sub |
0973 | Error_Found: |
0974 | Stop |
0975 | End Sub |