Going forward there are more and more systems that have somewhat un-formated text or memo fields. It can be useful to tag fields. Here’s a collection of 2 functions with a script to pull them together designed to create a junction table.
What’s nice about it is that it could be used in lots of situations as a nightly process to tag manually input notes to help assist users navigate screeds of text.
This code is generalized and would need to be adapted for your specific table and field names
In mine you will need 4 tables
T001TableContainingFieldtobeCatetgorized – as per title it has a field called PKID and a field Called Text which is the memo field against which the SQL compares categories
T002Category – table that contains the categories that are compared against the text field
T003JunctionTable – the junction table that will contain the links between our notes table and the category table.
T004SQL – table to contain update queries – the field storing the strings is SQLstring – RunQueriesFromTable uses the SQLstring query and places the result in T003JunctionTable
The function RunQueriesFromTable is a previous function I wrote
Function CategorizeField() 'Make sure the name of the recordset is unambiguous 'Good practice to reference the actual library Dim db As DAO.Database Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim rs3 As DAO.Recordset Dim SQLUpJunc As String strQuote = Chr$(34) Set db = CurrentDb Set rs1 = db.OpenRecordset("SELECT * FROM T001TableContainingFieldtobeCategorized") Set rs2 = db.OpenRecordset("T004SQL") Set rs3 = db.OpenRecordset("T002Category") 'the data source can be a Table Name a query name or an sql string 'it would be possible to change the SQL to set to another set of records 'Check to see if there are any records in the set If Not (rs3.EOF And rs3.BOF) Then 'there are no records if End of File and beginning of file are both true rs3.MoveFirst Do Until rs3.EOF = True SQLUpJunc = "INSERT INTO T003JunctionTable ( FKIDT001, FKIDT002 ) SELECT T001TableContainingFieldtobeCategorized.PKID, " & rs3!PKID & " AS FKIDT002 FROM T001TableContainingFieldtobeCategorized WHERE (((T001TableContainingFieldtobeCategorized.Text) Like " & strQuote & "*" & rs3!Category & "*" & strQuote & "));" With rs2 .AddNew rs2!SQLstring = SQLUpJunc rs2.Update End With rs3.MoveNext Loop Else 'MsgBox "No Records available for updating exit sub" Exit Function End If 'MsgBox "Looped through the records and updated table of SQL" rs2.Close Set rs1 = Nothing Set rs2 = Nothing Set rs3 = Nothing Set db = Nothing 'remember to break an infinite loop press ctrl + break End Function
Public Function RunQueriesFromTable(SQLSource As String) DoCmd.SetWarnings False Dim StartTime As Date Dim EndTime As Date Dim rstZ As DAO.Recordset Dim strSQL As String StartTime = Now() Set rstZ = CurrentDb.OpenRecordset(SQLSource) Do Until rstZ.EOF strSQL = rstZ!SQLstring DoCmd.RunSQL strSQL rstZ.MoveNext Loop DoCmd.SetWarnings True EndTime = Now() 'MsgBox "Finished ALL SQL queries! Process started at " & StartTime & " and finished at " & EndTime End Function
Public Function CreateJunctionTable() Call CategorizeField Call RunQueriesFromTable("T004SQL") MsgBox "Finished" End Function