MS Access – VBA Functions – Create Category Tag Junction Table by comparing a text field against a table of categories

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

About Mark

Mark Brooks a forty something individual working and living in and around Edinburgh

This entry was posted in All, Database Design, VBA Code MS Access. Bookmark the permalink.