Line-No. / Ref. | Code Line |
0001 | Public Sub AppAccess_Test() |
0002 | Dim start As Date |
0003 | Dim Duration As Single |
0004 | Dim rs As Recordset |
0005 | Dim strQuery As String |
0006 | Dim Note_Text As String |
0007 | Dim Note_Text_Saved As String |
0008 | Dim i As Integer |
0009 | start = Now() |
0010 | Dim appAccess As Access.Application |
0011 | ' Create instance of Access Application object. |
0012 | Set appAccess = CreateObject("Access.Application") |
0013 | ' Open Spider database in Microsoft Access window. |
0014 | appAccess.OpenCurrentDatabase "C:\Theo's Files\Birkbeck\Spider.accdb", False |
0015 | ' Run Sub procedure. |
0016 | appAccess.Run "Greeting", "Joe" 'Sub-name, parameter |
0017 | Set appAccess = Nothing |
0018 | Debug.Print Now() & " - " & i & " Notes records updated" |
0019 | Duration = Round((Now() - start) * 24 * 60 * 60, 2) |
0020 | MsgBox "Test Complete in " & Duration & " seconds. ", vbOKOnly, "Test" |
0021 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Change_Of_Year() |
0002 | Stop |
0003 | 'FOLLOW THE INSTRUCTIONS BELOW TO THE LETTER!! READ THEM CAREFULLY!!! |
0004 | 'IF DUPLICATE KEY ERRORS ARISE, IT'S BECAUSE YOU'VE FORGOTTEN SOMETHING! |
0005 | '1. Update the Project_Plans table for the coming year (only) |
0006 | '2. Output the end-September Quarterly Summary & Task-List Reports - the last for the "Old Year". XChk & re-run without "Temp" when happy. |
0007 | '3. Copy StudyPlan.xlsx to StudyPlan_Old.xlsx : VERY IMPORTANT!! |
0008 | '4. Update the Reporting_Months and Next_Reporting_Month tables : VERY IMPORTANT!! |
0009 | '5. Update the Year_Crosstab_List_Prime table : VERY IMPORTANT!! |
0010 | '6. Update and run the queries below ... |
0011 | DoCmd.OpenQuery ("Year_Crosstab_Old_Zap") 'Just needs running |
0012 | DoCmd.OpenQuery ("Year_Crosstab_Old_GEN") 'Just needs running |
0013 | DoCmd.OpenQuery ("New_Year_Crosstab_Prime_Zap") 'Update the query first! |
0014 | DoCmd.OpenQuery ("New_Year_Crosstab_Prime_OldYear_ADD") 'Update the query first! |
0015 | DoCmd.OpenQuery ("New_Year_Crosstab_Prime_NewYear_ADD") 'Just needs running ... after the above has been updated & run |
0016 | DoCmd.OpenQuery ("Project_Plans_NextYear_Add") 'Just needs running. This is for the year after next - it just copies the coming year's plans |
0017 | '7. Set up StudyPlan.xlsx for the new year |
0018 | '8. Also update the Oboe_Practice_Hours table and |
0019 | ' the Oboe-Practice report queries (Oboe_Practice_Hours_ADD, Oboe_Practice_Hours_Zeroise, Oboe_Practice_Hours_Update and Oboe_Practice_Hours_List) and |
0020 | ' add another Oboe_Practice_Hours_Temp_Dated_YYYY_GEN Query |
0021 | Stop |
0022 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Private Sub cmdPIDNoteReadingLists_Click() |
0002 | DoCmd.Close acQuery, "PID_Note_Reading_Lists_List_Selected" |
0003 | DoCmd.Close acQuery, "PID_Missing_Online_Papers_Editable_List" |
0004 | DoCmd.Close acQuery, "PID_Papers_Referenced_Undated_Editable" |
0005 | DoCmd.Close acQuery, "PID_Books_Referenced_Undated_Editable" |
0006 | DoCmd.Close acQuery, "PID_Note_Reading_Lists_Date_XChk" |
0007 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_List_Selected") |
0008 | DoCmd.OpenQuery ("PID_Missing_Online_Papers_Editable_List") |
0009 | DoCmd.OpenQuery ("PID_Papers_Referenced_Undated_Editable") |
0010 | DoCmd.OpenQuery ("PID_Books_Referenced_Undated_Editable") |
0011 | DoCmd.OpenQuery ("PID_Note_Reading_Lists_Date_XChk") |
0012 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Default_Text_Files() |
0002 | Dim TransferName As String |
0003 | Dim folder As String |
0004 | Dim strQuery As String |
0005 | Dim dummyfilename As String |
0006 | Dim templatefile As String |
0007 | Dim i As Integer |
0008 | Dim j As Integer |
0009 | Dim fs As Object |
0010 | Dim rs As Recordset |
0011 | Set fs = CreateObject("Scripting.FileSystemObject") |
0012 | folder = "C:\Theo's Files\Languages\Ling\zDummyFiles\" |
0013 | templatefile = folder & "Ling_Dummy.txt" |
0014 | 'strQuery = "SELECT Language_Location_Primer.Language_Key, Language_Location_Primer.Date_Last_Study FROM Language_Location_Primer WHERE (((Language_Location_Primer.Language_Key)>""An"") AND ((Language_Location_Primer.Date_Last_Study)>""0""));" |
0015 | strQuery = "SELECT Language_Location_Primer.Language_Key, Language_Location_Primer.Date_Last_Study FROM Language_Location_Primer WHERE (((Language_Location_Primer.Language_Key)=""Polish""));" |
0016 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0017 | rs.MoveFirst |
0018 | Do Until rs.EOF |
0019 | For j = 1 To 2 |
0020 | For i = 6 To 30 |
0021 | 'For i = 6 To 50 |
0022 | TransferName = folder & "Ling_" |
0023 | TransferName = TransferName & rs.Fields(0) |
0024 | TransferName = TransferName & "_Lesson" |
0025 | TransferName = TransferName & Right(i + 100, 2) |
0026 | Select Case j |
0027 | Case 1 |
0028 | TransferName = TransferName & "_Vocab.txt" |
0029 | Case 2 |
0030 | TransferName = TransferName & "_Dialogue.txt" |
0031 | End Select |
0032 | If Dir(TransferName) <> "" Then 'If we already have a dummy file, then zap it |
0033 | Kill TransferName |
0034 | End If |
0035 | fs.CopyFile templatefile, TransferName 'Copy the dummy file |
0036 | Next i |
0037 | Next j |
0038 | rs.MoveNext |
0039 | Loop |
0040 | Set fs = Nothing |
0041 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Espanso_Gen() |
0002 | 'Creates the 'matching file' for Expanso |
0003 | 'This file needs to be opened in Notepad++ and have its Encoding set to UTF-8; |
0004 | ' ... VBA CreateTextFile 3rd parameter set to "True" means Unicode, but UCF-16 rather than UCF-8 |
0005 | 'Then needs copying to C:\Users\Theo\AppData\Roaming\espanso\match ... copy this address to File Manager |
0006 | 'See https://espanso.org/ |
0007 | Dim strLine As String |
0008 | Dim strOutputFile As String |
0009 | Dim rsEspanso As Recordset |
0010 | Set fsoTextFile2 = New FileSystemObject |
0011 | Set rsEspanso = CurrentDb.OpenRecordset("SELECT * FROM Espanso;") |
0012 | strOutputFile = "C:\Theo's Files\Notes\Espanso_Notes.yml" |
0013 | Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFile, True, True) |
0014 | strLine = "matches:" |
0015 | tsTextFile.WriteLine strLine |
0016 | rsEspanso.MoveFirst |
0017 | Do Until rsEspanso.EOF |
0018 | strLine = " - trigger: """ & rsEspanso.Fields(2) & """" |
0019 | tsTextFile.WriteLine strLine |
0020 | strLine = " replace: ""[" & rsEspanso.Fields(3) & "]++" & rsEspanso.Fields(0) & "++""" |
0021 | tsTextFile.WriteLine strLine |
0022 | strLine = " propagate_case: true" |
0023 | tsTextFile.WriteLine strLine |
0024 | strLine = " word: true" |
0025 | tsTextFile.WriteLine strLine |
0026 | strLine = "" |
0027 | tsTextFile.WriteLine strLine |
0028 | rsEspanso.MoveNext |
0029 | Loop |
0030 | Set rsEspanso = Nothing |
0031 | Set fsoTextFile2 = Nothing |
0032 | Set tsTextFile = Nothing |
0033 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Function Functor_24(Note_ID, Snippet_ID, strValue, strOption) |
0002 | 'This function embeds a piece of text from the table Note_Snippets into a Note (or to the text in any other object, at least maybe in the future) |
0003 | 'This is work in progress and will doubtless expand in response to the needs of use! |
0004 | 'The convention is that the snippet, if it is a list, uses '|.|' for the bullet indicators, with no surrounding '|..|' delimeters |
0005 | 'If this is correct in the situation the snippet is to be placed, the parameter strOption should be set to "1" |
0006 | 'Otherwise, the parameters are:- |
0007 | '1 = '|.|', no delimeters ... or, left unadjusted |
0008 | '2 = '|.|', with delimeters |
0009 | '3 = '|1|', no delimeters |
0010 | '4 = '|1|', with delimeters |
0011 | 'The code below makes the necessary adjustments |
0012 | Dim rs As Recordset |
0013 | Dim strQuery As String |
0014 | Dim strValue_Local As String |
0015 | strQuery = "SELECT * FROM Note_Snippets WHERE ID = " & Snippet_ID & "; " |
0016 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0017 | If rs.EOF Then |
0018 | Debug.Print Now(); "- Note ID: " & Note_ID & ", Snippet ID: " & Snippet_ID & ". Functor_24 : No Note_Snippet found (Option = " & strOption & ")" |
0019 | Functor_24 = "No" |
0020 | Exit Function |
0021 | End If |
0022 | rs.MoveFirst |
0023 | strValue_Local = rs.Fields(1) |
0024 | Select Case strOption |
0025 | Case 1 |
0026 | Case 2 |
0027 | strValue_Local = "|..|" & strValue_Local & "|..|" |
0028 | Case 3 |
0029 | strValue_Local = Replace(strValue_Local, "|.|", "|1|") |
0030 | Case 4 |
0031 | strValue_Local = Replace(strValue_Local, "|.|", "|1|") |
0032 | strValue_Local = "|99|" & strValue_Local & "|99|" |
0033 | End Select |
0034 | Functor_24 = "Yes" |
0035 | strValue = strValue_Local |
0036 | Set rs = Nothing |
0037 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Sub Ling_Numbers_Dialogue() |
0002 | Dim rst As Recordset |
0003 | Dim rst2 As Recordset |
0004 | Dim rst3 As Recordset |
0005 | Dim strQuery As String |
0006 | Dim i As Integer |
0007 | Dim j As Integer |
0008 | strQuery = "SELECT * from Ling_Numbers_Dialogue_Ctrl;" |
0009 | Set rst = CurrentDb.OpenRecordset(strQuery) |
0010 | For i = 0 To 9 |
0011 | strQuery = "SELECT Ling_Dialogue_Language.Language, Ling_Dialogue_English.Lesson_ID, Ling_Dialogue_English.Dialogue_ID, Ling_Dialogue_English.Phrase_ID, Ling_Dialogue_English.Phrase_English, Ling_Dialogue_Language.Phrase_Language, Ling_Dialogue_Language.Phrase_Transliteration_Language FROM Ling_Dialogue_English INNER JOIN Ling_Dialogue_Language ON (Ling_Dialogue_English.Lesson_ID = Ling_Dialogue_Language.Lesson_ID) AND (Ling_Dialogue_English.Dialogue_ID = Ling_Dialogue_Language.Dialogue_ID) AND (Ling_Dialogue_English.Phrase_ID = Ling_Dialogue_Language.Phrase_ID)" |
0012 | strQuery = strQuery & " WHERE (((Ling_Dialogue_English.Phrase_English) Like ""*" & i & "*"")) OR (((Ling_Dialogue_Language.Phrase_Language) Like ""*" & i & "*"")) OR (((Ling_Dialogue_Language.Phrase_Transliteration_Language) Like ""*" & i & "*"")) ORDER BY Ling_Dialogue_Language.Language, Ling_Dialogue_English.Dialogue_ID, Ling_Dialogue_English.Phrase_ID;" |
0013 | Set rst2 = CurrentDb.OpenRecordset(strQuery) |
0014 | If Not rst2.EOF Then |
0015 | rst2.MoveFirst |
0016 | Do Until rst2.EOF |
0017 | strQuery = "SELECT * FROM Ling_Numbers_Dialogue_Ctrl WHERE Language = """ & rst2.Fields(0) & """ AND Lesson_ID = " & rst2.Fields(1) & " AND Dialogue_ID = " & rst2.Fields(2) & " AND Phrase_ID = " & rst2.Fields(3) & ";" |
0018 | Set rst3 = CurrentDb.OpenRecordset(strQuery) |
0019 | If rst3.EOF Then |
0020 | rst.AddNew |
0021 | For j = 0 To 6 |
0022 | rst.Fields(j) = rst2.Fields(j) |
0023 | Next j |
0024 | rst.Fields(7) = i |
0025 | rst.Update |
0026 | Debug.Print "Add New" |
0027 | Else |
0028 | If rst3.Fields(8) = False Then |
0029 | rst3.Edit |
0030 | rst3.Fields(7) = rst3.Fields(7) & i |
0031 | rst3.Update |
0032 | Debug.Print "Update" |
0033 | End If |
0034 | End If |
0035 | Set rst3 = Nothing |
0036 | rst2.MoveNext |
0037 | Loop |
0038 | End If |
0039 | Set rst2 = Nothing |
0040 | Next i |
0041 | DoCmd.OpenQuery ("Ling_Numbers_Dialogue_Ctrl_Complete") |
0042 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Oboe_Practice_Test() |
0002 | 'Produce Oboe-Practice report |
0003 | DoCmd.OpenQuery ("Oboe_Latest_Lesson_Zap") |
0004 | DoCmd.OpenQuery ("Oboe_Latest_Lesson_GEN") |
0005 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap") |
0006 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap") |
0007 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN") |
0008 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN") |
0009 | DoCmd.OpenQuery ("Oboe_Practice_Hours_ADD") |
0010 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Zeroise") |
0011 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Update") |
0012 | 'Since last lesson |
0013 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Zap") |
0014 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Zap") |
0015 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_GEN") |
0016 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_2021_GEN") |
0017 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_LastYear_GEN") |
0018 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_Dated_Last_Lesson_Prune") |
0019 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Temp_GEN") |
0020 | DoCmd.OpenQuery ("Oboe_Practice_Hours_Latest_Lesson_Update") |
0021 | DoCmd.OpenQuery ("Oboe_Practice_Hours_List") |
0022 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Output_Ling_Pages() |
0002 | DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE (((Notes.ID)=1320)) OR (((Notes.ID)=1321)) OR (((Notes.ID)=1322)) OR (((Notes.ID)=1323)) OR (((Notes.ID)=1324)) OR (((Notes.ID)=1325)) OR (((Notes.ID)=1326)) OR (((Notes.ID)=1327)) OR (((Notes.ID)=1331)) OR (((Notes.ID)=1332)) OR (((Notes.ID)=1335)) OR (((Notes.ID)=1336)) OR (((Notes.ID)=1337)) OR (((Notes.ID)=1338)) OR (((Notes.ID)=1339));") |
0003 | DoCmd.RunSQL ("DELETE * FROM Notes_To_Regen;") |
0004 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1320));") 'Summary Page |
0005 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1321));") 'Regenerate Vocabulary (Latin Scripts) |
0006 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1322));") 'Regenerate Vocabulary (Non-Latin Scripts) |
0007 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1323));") 'Regenerate Dialogue (Latin Scripts) |
0008 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1324));") 'Regenerate Dialogue (Non-Latin Scripts) |
0009 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1325));") 'Regenerate Vocabulary CrossTab |
0010 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1326));") 'Regenerate Vocabulary Phrase CrossTab |
0011 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1327));") 'Regenerate Dialogue CrossTab |
0012 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1331));") 'Regenerate Vocabulary CrossTab - Lesson Order |
0013 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1332));") 'Regenerate Vocabulary Phrase CrossTab - Lesson Order |
0014 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1335));") 'Regenerate Vocabulary CrossTab (Ukrainian vs Russian vs Polish) |
0015 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1336));") 'Regenerate Vocabulary CrossTab (Ukrainian vs Russian vs Polish) - Lesson Sequence |
0016 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1337));") 'Regenerate Vocabulary Phrase CrossTab (Ukrainian vs Russian vs Polish) |
0017 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1338));") 'Regenerate Vocabulary Phrase CrossTab (Ukrainian vs Russian vs Polish) - Lesson Sequence |
0018 | DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1339));") 'Regenerate Dialogue CrossTab (Ukrainian vs Russian vs Polish) |
0019 | Archive_Notes_Now = "No" |
0020 | Regenerate_the_Links = "No" |
0021 | Regen_Notes_Only = "Yes" |
0022 | CreateNotesWebPages ("Yes") |
0023 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Transfer_PDF_Files() |
0002 | Dim fso As FileSystemObject |
0003 | Dim MainFolder |
0004 | Dim FileCollection |
0005 | Dim File |
0006 | Dim DirectoryNameFrom As String |
0007 | Dim DirectoryNameTo As String |
0008 | Dim File_NameFrom As String |
0009 | Dim File_NameTo As String |
0010 | Dim i As Integer |
0011 | Dim j As Integer |
0012 | Dim rs As Recordset |
0013 | Dim strQuery As String |
0014 | Dim fs As Object |
0015 | Dim pre_run As Boolean |
0016 | OK = MsgBox("Transfer_PDF_Files: Updating run?", vbYesNo) |
0017 | If OK = vbYes Then |
0018 | pre_run = False |
0019 | Else |
0020 | pre_run = True |
0021 | End If |
0022 | If pre_run = False Then |
0023 | OK = MsgBox("This is an updating run. Proceed?", vbYesNo) |
0024 | Stop |
0025 | End If |
0026 | Set fso = CreateObject("Scripting.FileSystemObject") |
0027 | Set fs = CreateObject("Scripting.FileSystemObject") |
0028 | DirectoryNameFrom = "C:\Theo's Files\PID_PDFs\" |
0029 | DirectoryNameTo = TheoWebsiteRoot & "\PDFs\" |
0030 | Set MainFolder = fso.GetFolder(DirectoryNameFrom) |
0031 | Set FileCollection = MainFolder.Files |
0032 | For Each File In FileCollection |
0033 | File_NameFrom = File.Name |
0034 | File_NameTo = File.Name |
0035 | File_NameTo = Replace(File_NameTo, ".pdf", "") |
0036 | File_NameTo = Replace(File_NameTo, "’", "") |
0037 | File_NameTo = Replace(File_NameTo, "'", "") |
0038 | File_NameTo = Replace(File_NameTo, ",", "") |
0039 | File_NameTo = Replace(File_NameTo, ".", "") |
0040 | File_NameTo = Replace(File_NameTo, " ", " ") |
0041 | File_NameTo = Replace(File_NameTo, " - ", "_") |
0042 | File_NameTo = Replace(File_NameTo, " ", "_") |
0043 | If Len(File_NameTo) > 59 Then |
0044 | i = 0 |
0045 | Do While i < 60 |
0046 | i = i + 1 |
0047 | j = i |
0048 | i = InStr(i, File_NameTo, "_") |
0049 | If i = 0 Then |
0050 | i = 60 |
0051 | End If |
0052 | Loop |
0053 | If j = 1 Or j < 20 Then |
0054 | j = 60 |
0055 | End If |
0056 | File_NameTo = Left(File_NameTo, j - 2) |
0057 | End If |
0058 | If InStr(File_NameTo, " ") > 0 Then |
0059 | Stop 'Bug |
0060 | End If |
0061 | 'Add to PDF_File_Control |
0062 | strQuery = "SELECT * FROM PDF_File_Control WHERE File_Name = """ & File_NameTo & """;" |
0063 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0064 | If rs.EOF Then |
0065 | If pre_run = False Then |
0066 | rs.AddNew |
0067 | rs.Fields(1) = File_NameTo |
0068 | rs.Fields(2) = Now() |
0069 | rs.Fields(3) = 0 |
0070 | rs.Update |
0071 | Else |
0072 | Debug.Print File_NameFrom; " "; File_NameTo |
0073 | Stop |
0074 | End If |
0075 | End If |
0076 | If pre_run = False Then |
0077 | 'Copy File |
0078 | Set rs = Nothing |
0079 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0080 | rs.MoveFirst |
0081 | If rs.Fields(4) = False Then |
0082 | rs.Edit |
0083 | rs.Fields(4) = True |
0084 | rs.Update |
0085 | 'Copy file |
0086 | File_NameFrom = DirectoryNameFrom & File_NameFrom |
0087 | File_NameTo = DirectoryNameTo & File_NameTo & ".pdf" |
0088 | If Dir(File_NameTo) <> "" Then |
0089 | Kill File_NameTo |
0090 | End If |
0091 | fs.CopyFile File_NameFrom, File_NameTo |
0092 | End If |
0093 | End If |
0094 | Next File |
0095 | If pre_run = False Then |
0096 | DoCmd.OpenTable ("PDF_File_Control") |
0097 | End If |
0098 | OK = MsgBox("Transfer_PDF_Files Complete") |
0099 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Update_Papers_PDF_File_ID() |
0002 | Dim rs As Recordset |
0003 | Dim strQuery As String |
0004 | Dim Paper_Comment As String |
0005 | Dim Paper_Comment_Link As String |
0006 | Dim pre_run As Boolean |
0007 | OK = MsgBox("Update_Papers_PDF_File_ID: Updating run?", vbYesNo) |
0008 | If OK = vbYes Then |
0009 | pre_run = False |
0010 | Else |
0011 | pre_run = True |
0012 | End If |
0013 | If pre_run = False Then |
0014 | OK = MsgBox("This is an updating run of the Papers table. Proceed?", vbYesNo) |
0015 | Stop |
0016 | Else |
0017 | DoCmd.OpenQuery ("Paper_Comment_PDF_Update") |
0018 | End If |
0019 | strQuery = "Paper_Comment_PDF_Update" |
0020 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0021 | If Not rs.EOF Then |
0022 | rs.MoveFirst |
0023 | Do While Not rs.EOF |
0024 | Paper_Comment = rs.Fields(5) & "" |
0025 | Paper_Comment_Link = "For the full text, follow this link (Local website only): +F" & rs.Fields(1) & "F+." |
0026 | If InStr(Paper_Comment, "|") > 0 Then |
0027 | Paper_Comment = Paper_Comment_Link & Chr$(10) & Paper_Comment |
0028 | Else |
0029 | If Paper_Comment = "" Then |
0030 | Paper_Comment = Paper_Comment_Link |
0031 | Else |
0032 | Paper_Comment = "|..||.|" & Paper_Comment_Link & "|.|" & Paper_Comment & "|..|" |
0033 | End If |
0034 | End If |
0035 | If pre_run = False Then |
0036 | rs.Edit |
0037 | rs.Fields(5) = Paper_Comment |
0038 | rs.Fields(6) = True |
0039 | rs.Update |
0040 | Else |
0041 | Debug.Print Paper_Comment |
0042 | End If |
0043 | rs.MoveNext |
0044 | Loop |
0045 | End If |
0046 | OK = MsgBox("Update_Papers_PDF_File_ID Complete") |
0047 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Update_PDF_Files_Paper_ID() |
0002 | Dim rs_yy As Recordset |
0003 | Dim rs_PDFs As Recordset |
0004 | Dim strQuery As String |
0005 | Dim yy_Author_Chk As String |
0006 | Dim PDFs_Author_Chk As String |
0007 | Dim i As Integer |
0008 | Dim pre_run As Boolean |
0009 | OK = MsgBox("Update_PDF_Files_Paper_ID: Updating run?", vbYesNo) |
0010 | If OK = vbYes Then |
0011 | pre_run = False |
0012 | Else |
0013 | pre_run = True |
0014 | End If |
0015 | If pre_run = False Then |
0016 | OK = MsgBox("This is an updating run. Proceed?", vbYesNo) |
0017 | Stop |
0018 | End If |
0019 | strQuery = "SELECT yy.*, Trim(IIf(InStr([author],""("")>0,Left([Author],InStr([author],""("")-1),[Author])) AS Expr1 FROM yy WHERE ((([OK?] & """") = """")) ORDER BY Trim(IIf(InStr([author],""("")>0,Left([Author],InStr([author],""("")-1),[Author])), replace(yy.Title,"":"","""");" |
0020 | Set rs_yy = CurrentDb.OpenRecordset(strQuery) |
0021 | strQuery = "SELECT PDF_File_Control.* FROM PDF_File_Control WHERE (((PDF_File_Control.Paper_ID) = 0)) ORDER BY PDF_File_Control.File_Name;" |
0022 | Set rs_PDFs = CurrentDb.OpenRecordset(strQuery) |
0023 | If rs_yy.EOF Or rs_PDFs.EOF Then |
0024 | Stop |
0025 | End If |
0026 | rs_yy.MoveFirst |
0027 | rs_PDFs.MoveFirst |
0028 | Do Until rs_PDFs.EOF |
0029 | i = InStr(rs_yy.Fields(1), "(") |
0030 | If i > 0 Then |
0031 | yy_Author_Chk = Trim(Left(rs_yy.Fields(1), i - 1)) |
0032 | i = InStr(rs_PDFs.Fields(1), "_") |
0033 | If i > 0 Then |
0034 | PDFs_Author_Chk = Trim(Left(rs_PDFs.Fields(1), i - 1)) |
0035 | If yy_Author_Chk = PDFs_Author_Chk Then |
0036 | If pre_run = True Then |
0037 | Debug.Print rs_PDFs.Fields(1); " : "; rs_yy.Fields(1); " : "; rs_yy.Fields(2) |
0038 | 'Stop |
0039 | Else |
0040 | rs_PDFs.Edit |
0041 | rs_PDFs.Fields(3) = rs_yy.Fields(4) |
0042 | rs_PDFs.Update |
0043 | End If |
0044 | Else |
0045 | Debug.Print rs_PDFs.Fields(1); " : "; rs_yy.Fields(1); " : "; rs_yy.Fields(2) |
0046 | Stop |
0047 | If pre_run = True Then |
0048 | Else |
0049 | rs_PDFs.Edit |
0050 | rs_PDFs.Fields(3) = rs_yy.Fields(4) |
0051 | rs_PDFs.Update |
0052 | End If |
0053 | End If |
0054 | Else |
0055 | Stop |
0056 | End If |
0057 | End If |
0058 | rs_yy.MoveNext |
0059 | rs_PDFs.MoveNext |
0060 | Loop |
0061 | OK = MsgBox("Update_PDF_Files_Paper_ID Complete") |
0062 | End Sub |