Skip to content
Advertisement

Adding new records to Access table on an update to a linked table in Access VBA SQL

I have two table one (skillsMatrix) the other table is (elementTree) with columns [mediumElement], [ID] in table skillsMatrix the mediumElement is a lookup dropdown of the mediumElements in table two. I want to write a macro to update skills matrix table to add a new record “name”, “new topic”,”” and not duplicate any of the other records when a new mediumElement is added to elementTree.

Table: skillsMatrix

id employee mediumElement completionDate
autoNumber Dave Walking 10/27/2020

Table: elementTree

Id mediumElement
26 Walking
27 Running

I’d like the skillsMatrix table to look like this after running the code

id employee mediumElement completionDate
autoNumber Dave Walking 10/27/2020
autoNumber Dave Running

I have tried the following to troubleshoot for building out the logic. The following prints out with RS always starting with 1 and ME starting with the proper ID for the mediumElement in element tree.
rs
1
ME
26
rs
2
ME
27
rs
3
ME
28
rs
4
ME
29
rs
5
ME
30
rs
6
ME
31
rs
7
ME
32
rs
8
ME
33
rs
9
ME
34
rs
10
ME
35

Dim db                    As DAO.Database
Dim rs                    As DAO.Recordset
Dim mediumElements        As DAO.Recordset
Dim employeeTable         As DAO.Recordset
Dim strSQL                As String
Dim strSQLName            As String
Dim strSQLintegrityCheck    As String
Dim idValue     As Long
Dim recordExists          As Boolean
If Me.Dirty = True Then Me.Dirty = False 'Save any unsaved data
Set db = CurrentDb
strSQLName = "SELECT employeeTable.ID, employeeTable.[Employee Name] FROM employeeTable WHERE (((employeeTable.[Employee Name])=""" & Me.employeeName & """));"
Set employeeTable = db.OpenRecordset(strSQLName)
idValue = employeeTable.Fields("ID")
Debug.Print (idValue)
strSQLintegrityCheck = "Select skillsMatrix.employee, skillsMatrix.mediumElement From skillsMatrix Where skillsMatrix.employee =  " & idValue & ""
Set rs = db.OpenRecordset("skillsMatrix")
strSQL = "Select elementTree.[ID], elementTree.[mediumElement] From elementTree  Where  ( elementTree.plantPosition = " & Me.jobPosition & ")"
'Debug.Print strSQL
Set mediumElements = db.OpenRecordset(strSQL)
Debug.Print employeeTable.Fields("ID")
If Not mediumElements.BOF And Not mediumElements.EOF Then
    mediumElements.MoveFirst
    rs.MoveFirst
    While (Not mediumElements.EOF)
       Debug.Print ("rs")
       Debug.Print rs.Fields("mediumElement").Value
       Debug.Print ("ME")
       Debug.Print mediumElements.Fields("id")
        If (rs![employee] <> employeeTable.Fields("ID") And rs![mediumElement] <> mediumElements.Fields("ID")) Then
             With rs
                .AddNew
                ![employee] = employeeTable.Fields("ID")
                ![mediumElement] = mediumElements.Fields("ID")
                .Update
            End With
         End If
       rs.MoveNext
       mediumElements.MoveNext
    Wend
End If
rs.Close
Set rs = Nothing
Set mediumElements = Nothing
Set employeeTable = Nothing

Nothing happens/wrong thing happens as the rs.Fields(“mediumElement”) does not give the what I would expect as the correct value. Instead of rs.[mediumElement] displaying the lookup ID of element from the elementTree table it always displays 1 through number of records in RS for rs.Fields(“mediumElement”). There is an employees table and the IDs are being saved in skillsMatrix. Although I used the lookup wizard when building the connections so that could be the problem. I apologize for my poor vernacular I’m pretty new to access and SQL.

I do not want all employees to be updated with the associated new element. The code is a sub controlled by a button press and the employee to be updated is selected on that form with the control employeeName

EDIT: On of the suggestion looking into Insert Select

the following works for adding the mediumElements to the skills matrix table, based on whether or not they exist for a user. Is there a way to also add the employee name to the skills matrixTable with the same Insert Into?

Dim sqlString As String
Dim name As String
Dim strSQLName As String
Dim db                    As DAO.Database




Set db = CurrentDb
Dim employeeTable As DAO.Recordset


strSQLName = "SELECT employeeTable.ID, employeeTable.[Employee Name] FROM employeeTable WHERE (((employeeTable.[Employee Name])=""" & Me.employeeName & """));"
    Set employeeTable = db.OpenRecordset(strSQLName)
    idValue = employeeTable.Fields("ID")

    Debug.Print (name)
sqlString = "INSERT INTO skillsMatrix (mediumElement)" _
            & "SELECT elementTree.ID FROM elementTree " _
            & "WHERE NOT EXISTS(SELECT * FROM skillsMatrix Where skillsMatrix.mediumElement = elementTree.ID AND skillsMatrix.employee = " & idValue & " ) "
            
   DoCmd.RunSQL sqlString
End Sub


Advertisement

Answer

If employee is selected via a combobox on form, there is no need to open a recordset just to get employee ID. EmployeeID should be a hidden column of combobox and combobox should have that as its value.

idValue = Me.employeeName

If Employee ID is not available on form, a recordset is still not needed. Use DLookup.
idValue = DLookup("ID", "employeeTable", "[Employee Name]='" & Me.employeeName & "'")

Include employee field in INSERT clause and concatenate idValue to produce a calculated field in the SELECT from elementTree clause.

sqlString = "INSERT INTO skillsMatrix (employee, mediumElement) " _
            & "SELECT " & idValue & " AS Emp, elementTree.ID FROM elementTree " _
            & "WHERE NOT EXISTS(SELECT * FROM skillsMatrix WHERE skillsMatrix.mediumElement = elementTree.ID AND skillsMatrix.employee = " & idValue & " ) "

If employee and mediumElement are defined as a compound index in table, then don’t really need the WHERE criteria since duplicate pairs will not be allowed. I don’t know if this WHERE criteria slows or improves performance.

If new element ID can be captured from form, simplify code:

sqlString = "INSERT INTO skillsMatrix (employee, mediumElement) " _
            & "VALUES(" & idValue & "," & idElement & ")"

Use CurrentDb.Execute instead of DoCmd.RunSQL and won’t get warning popups.

User contributions licensed under: CC BY-SA
6 People found this is helpful
Advertisement