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

cmdPIDNoteReadingLists_ClickcmdSnippet_ClickFunctor_24AppAccess_Test
Bible_LoadChange_Of_YearDefault_Text_FilesEspanso_Gen
Ling_Numbers_DialogueOboe_Practice_TestOutput_Ling_PagesTransfer_PDF_Files
Update_Papers_PDF_File_IDUpdate_PDF_Files_Paper_ID..

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

Go to top of page



Source Code of: AppAccess_Test
Procedure Type: Public Sub
Module: Testing
Lines of Code: 21
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub AppAccess_Test()
0002Dim start As Date
0003Dim Duration As Single
0004Dim rs As Recordset
0005Dim strQuery As String
0006Dim Note_Text As String
0007Dim Note_Text_Saved As String
0008Dim i As Integer
0009start = 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
0018Debug.Print Now() & " - " & i & " Notes records updated"
0019Duration = Round((Now() - start) * 24 * 60 * 60, 2)
0020MsgBox "Test Complete in " & Duration & " seconds. ", vbOKOnly, "Test"
0021End Sub

Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Bible_Load
Procedure Type: Public Sub
Module: Testing
Lines of Code: 35
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Bible_Load()
0002Dim rs As Recordset
0003Dim rs_xls As Recordset
0004Dim strQuery As String
0005Dim iChapters As Integer
0006Dim i As Integer
0007Dim OTNT As String
0008Dim Book_ID As Integer
0009Dim Book As String
0010 strQuery = "SELECT * FROM Bible_Reading_Control;"
0011Set rs = CurrentDb.OpenRecordset(strQuery)
0012 strQuery = "SELECT B2.* FROM B2 ORDER BY B2.OTNT, B2.[Book ID], B2.Book;"
0013Set rs_xls = CurrentDb.OpenRecordset(strQuery)
0014rs_xls.MoveFirst
0015Do Until rs_xls.EOF
0016 If rs_xls.Fields(0) = 1 Then
0017 OTNT = "OT"
0018 Else
0019 OTNT = "NT"
0020 End If
0021 Book_ID = rs_xls.Fields(1)
0022 Book = rs_xls.Fields(2)
0023 iChapters = rs_xls.Fields(3)
0024 For i = 1 To iChapters
0025 rs.AddNew
0026 rs.Fields(0) = OTNT
0027 rs.Fields(1) = Book_ID
0028 rs.Fields(2) = Book
0029 rs.Fields(3) = i
0030 rs.Fields(4) = rs_xls.Fields(3 + i)
0031 rs.Update
0032 Next i
0033 rs_xls.MoveNext
0034Loop
0035End Sub

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


Source Code of: Change_Of_Year
Procedure Type: Public Sub
Module: Testing
Lines of Code: 22
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Change_Of_Year()
0002Stop
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
0021Stop
0022End Sub

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


Source Code of: cmdPIDNoteReadingLists_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 12

Line-No. / Ref.Code Line
0001Private 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")
0012End Sub

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


Source Code of: cmdSnippet_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 4

Line-No. / Ref.Code Line
0001Private Sub cmdSnippet_Click()
0002 DoCmd.Close acQuery, "Note_Snippet_Lookup"
0003 DoCmd.OpenQuery ("Note_Snippet_Lookup")
0004End Sub

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


Source Code of: Default_Text_Files
Procedure Type: Public Sub
Module: Ling
Lines of Code: 41
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Default_Text_Files()
0002Dim TransferName As String
0003Dim folder As String
0004Dim strQuery As String
0005Dim dummyfilename As String
0006Dim templatefile As String
0007Dim i As Integer
0008Dim j As Integer
0009Dim fs As Object
0010Dim rs As Recordset
0011Set fs = CreateObject("Scripting.FileSystemObject")
0012folder = "C:\Theo's Files\Languages\Ling\zDummyFiles\"
0013templatefile = 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""));"
0016Set rs = CurrentDb.OpenRecordset(strQuery)
0017rs.MoveFirst
0018Do 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
0039Loop
0040Set fs = Nothing
0041End Sub

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


Source Code of: Espanso_Gen
Procedure Type: Public Sub
Module: Testing
Lines of Code: 33
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public 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/
0007Dim strLine As String
0008Dim strOutputFile As String
0009Dim rsEspanso As Recordset
0010Set fsoTextFile2 = New FileSystemObject
0011 Set rsEspanso = CurrentDb.OpenRecordset("SELECT * FROM Espanso;")
0012strOutputFile = "C:\Theo's Files\Notes\Espanso_Notes.yml"
0013Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFile, True, True)
0014strLine = "matches:"
0015tsTextFile.WriteLine strLine
0016rsEspanso.MoveFirst
0017Do 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
0029Loop
0030Set rsEspanso = Nothing
0031Set fsoTextFile2 = Nothing
0032Set tsTextFile = Nothing
0033End Sub

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


Source Code of: Functor_24
Procedure Type: Public Function
Module: Functors
Lines of Code: 37
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public 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
0012Dim rs As Recordset
0013Dim strQuery As String
0014Dim strValue_Local As String
0015 strQuery = "SELECT * FROM Note_Snippets WHERE ID = " & Snippet_ID & "; "
0016Set rs = CurrentDb.OpenRecordset(strQuery)
0017If 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
0021End If
0022rs.MoveFirst
0023strValue_Local = rs.Fields(1)
0024Select 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|"
0033End Select
0034Functor_24 = "Yes"
0035strValue = strValue_Local
0036Set rs = Nothing
0037End Function

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


Source Code of: Ling_Numbers_Dialogue
Procedure Type: Public Sub
Module: Ling
Lines of Code: 42
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Ling_Numbers_Dialogue()
0002Dim rst As Recordset
0003Dim rst2 As Recordset
0004Dim rst3 As Recordset
0005Dim strQuery As String
0006Dim i As Integer
0007Dim j As Integer
0008 strQuery = "SELECT * from Ling_Numbers_Dialogue_Ctrl;"
0009Set rst = CurrentDb.OpenRecordset(strQuery)
0010For 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
0040Next i
0041 DoCmd.OpenQuery ("Ling_Numbers_Dialogue_Ctrl_Complete")
0042End Sub

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


Source Code of: Oboe_Practice_Test
Procedure Type: Public Sub
Module: Testing
Lines of Code: 22
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public 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")
0022End Sub

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


Source Code of: Output_Ling_Pages
Procedure Type: Public Sub
Module: Ling
Lines of Code: 23
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public 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)
0019Archive_Notes_Now = "No"
0020Regenerate_the_Links = "No"
0021Regen_Notes_Only = "Yes"
0022 CreateNotesWebPages ("Yes")
0023End Sub

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


Source Code of: Transfer_PDF_Files
Procedure Type: Public Sub
Module: Testing
Lines of Code: 99
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Transfer_PDF_Files()
0002Dim fso As FileSystemObject
0003Dim MainFolder
0004Dim FileCollection
0005Dim File
0006Dim DirectoryNameFrom As String
0007Dim DirectoryNameTo As String
0008Dim File_NameFrom As String
0009Dim File_NameTo As String
0010Dim i As Integer
0011Dim j As Integer
0012Dim rs As Recordset
0013Dim strQuery As String
0014Dim fs As Object
0015Dim pre_run As Boolean
0016OK = MsgBox("Transfer_PDF_Files: Updating run?", vbYesNo)
0017If OK = vbYes Then
0018 pre_run = False
0019Else
0020 pre_run = True
0021End If
0022If pre_run = False Then
0023 OK = MsgBox("This is an updating run. Proceed?", vbYesNo)
0024 Stop
0025End If
0026Set fso = CreateObject("Scripting.FileSystemObject")
0027Set fs = CreateObject("Scripting.FileSystemObject")
0028DirectoryNameFrom = "C:\Theo's Files\PID_PDFs\"
0029DirectoryNameTo = TheoWebsiteRoot & "\PDFs\"
0030Set MainFolder = fso.GetFolder(DirectoryNameFrom)
0031Set FileCollection = MainFolder.Files
0032For 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
0094Next File
0095If pre_run = False Then
0096 DoCmd.OpenTable ("PDF_File_Control")
0097End If
0098OK = MsgBox("Transfer_PDF_Files Complete")
0099End Sub

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


Source Code of: Update_Papers_PDF_File_ID
Procedure Type: Public Sub
Module: Testing
Lines of Code: 47
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Update_Papers_PDF_File_ID()
0002Dim rs As Recordset
0003Dim strQuery As String
0004Dim Paper_Comment As String
0005Dim Paper_Comment_Link As String
0006Dim pre_run As Boolean
0007OK = MsgBox("Update_Papers_PDF_File_ID: Updating run?", vbYesNo)
0008If OK = vbYes Then
0009 pre_run = False
0010Else
0011 pre_run = True
0012End If
0013If pre_run = False Then
0014 OK = MsgBox("This is an updating run of the Papers table. Proceed?", vbYesNo)
0015 Stop
0016Else
0017 DoCmd.OpenQuery ("Paper_Comment_PDF_Update")
0018End If
0019 strQuery = "Paper_Comment_PDF_Update"
0020Set rs = CurrentDb.OpenRecordset(strQuery)
0021If 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
0045End If
0046OK = MsgBox("Update_Papers_PDF_File_ID Complete")
0047End Sub

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


Source Code of: Update_PDF_Files_Paper_ID
Procedure Type: Public Sub
Module: Testing
Lines of Code: 62
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Update_PDF_Files_Paper_ID()
0002Dim rs_yy As Recordset
0003Dim rs_PDFs As Recordset
0004Dim strQuery As String
0005Dim yy_Author_Chk As String
0006Dim PDFs_Author_Chk As String
0007Dim i As Integer
0008Dim pre_run As Boolean
0009OK = MsgBox("Update_PDF_Files_Paper_ID: Updating run?", vbYesNo)
0010If OK = vbYes Then
0011 pre_run = False
0012Else
0013 pre_run = True
0014End If
0015If pre_run = False Then
0016 OK = MsgBox("This is an updating run. Proceed?", vbYesNo)
0017 Stop
0018End 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,"":"","""");"
0020Set 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;"
0022Set rs_PDFs = CurrentDb.OpenRecordset(strQuery)
0023If rs_yy.EOF Or rs_PDFs.EOF Then
0024 Stop
0025End If
0026rs_yy.MoveFirst
0027rs_PDFs.MoveFirst
0028Do 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
0060Loop
0061OK = MsgBox("Update_PDF_Files_Paper_ID Complete")
0062End Sub

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


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