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
