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

Functor_24AppAccess_TestBible_LoadDefault_Text_Files
Output_Ling_PagesTransfer_PDF_FilesUpdate_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: Default_Text_Files
Procedure Type: Public Sub
Module: Ling
Lines of Code: 39
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""));"
0015Set rs = CurrentDb.OpenRecordset(strQuery)
0016rs.MoveFirst
0017Do Until rs.EOF
0018 For j = 1 To 2
0019 For i = 6 To 50
0020 TransferName = folder & "Ling_"
0021 TransferName = TransferName & rs.Fields(0)
0022 TransferName = TransferName & "_Lesson"
0023 TransferName = TransferName & Right(i + 100, 2)
0024 Select Case j
0025 Case 1
0026 TransferName = TransferName & "_Vocab.txt"
0027 Case 2
0028 TransferName = TransferName & "_Dialogue.txt"
0029 End Select
0030 If Dir(TransferName) <> "" Then 'If we already have a dummy file, then zap it
0031 Kill TransferName
0032 End If
0033 fs.CopyFile templatefile, TransferName 'Copy the dummy file
0034 Next i
0035 Next j
0036 rs.MoveNext
0037Loop
0038Set fs = Nothing
0039End 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: 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 incorrect 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: Output_Ling_Pages
Procedure Type: Public Sub
Module: Ling
Lines of Code: 17

Line-No. / Ref.Code Line
0001Public Sub Output_Ling_Pages()
0002 DoCmd.RunSQL ("UPDATE Notes SET Notes.Status = ""Temp"" WHERE (((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));")
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)=1321));") 'Regenerate Vocabulary (Latin Scripts)
0005 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1322));") 'Regenerate Vocabulary (Non-Latin Scripts)
0006 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1323));") 'Regenerate Dialogue (Latin Scripts)
0007 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1324));") 'Regenerate Dialogue (Non-Latin Scripts)
0008 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1325));") 'Regenerate Vocabulary CrossTab
0009 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1326));") 'Regenerate Vocabulary Phrase CrossTab
0010 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1327));") 'Regenerate Dialogue CrossTab
0011 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1331));") 'Regenerate Vocabulary CrossTab - Lesson Order
0012 DoCmd.RunSQL ("INSERT INTO Notes_To_Regen ( Note_ID ) SELECT Notes.ID FROM Notes WHERE (((Notes.ID)=1332));") 'Regenerate Vocabulary Phrase CrossTab - Lesson Order
0013Archive_Notes_Now = "No"
0014Regenerate_the_Links = "No"
0015Regen_Notes_Only = "Yes"
0016 CreateNotesWebPages ("Yes")
0017End Sub

Procedures Called By This Procedure (Output_Ling_Pages) Tables / Queries / Fragments Directly Used By This Procedure (Output_Ling_Pages) 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 = "C:\Theo's Files\Websites\Theo's Website\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 - Jan 2022. 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