snippets/microsoft/ms-office/access/PopulateMultiValue.vba

Sub PopulateMultiValue()

    Dim db As DAO.Database
    Dim srcTbl As String: srcTbl = "ExtraLoad"  ' Source table name
    Dim srcRS As DAO.Recordset2
    Dim srcQry As String
    Dim srcQdf As DAO.QueryDef
    Dim csv() As String
    Dim csvString As String
    Dim csvSize As Integer
    
    Dim tgtTbl As String: tgtTbl = "inventory2" ' Target table name
    Dim tgtRS As DAO.Recordset2
    
    Dim idFld As String: idFld = "[Unique ID]"  ' Field to join the src with tgt table
    Dim ID As String
    Dim flds() As String: flds = Split("[Used in Site],[Supplier Name],[Integrator Name],[Hosting Partner Name]", ",")
    'Dim flds() As String: flds = Split("[Used in Site]", ",")
    Dim fld As Variant
         
    Dim mvfld As DAO.Field2                     ' Multi-value record set
    Dim mvrs As DAO.Recordset2                  ' Multi-value field
    
    ' Open source and target
    
    Debug.Print "Start "; Format(Now(), "yyyy-MM-dd hh:mm:ss")
    Set db = CurrentDb()
    Set srcRS = db.OpenRecordset(srcTbl)
    Set tgtRS = db.OpenRecordset(tgtTbl)
       
    For Each fld In flds
        
        Debug.Print "**********Begin with field: "; fld
        Set mvfld = tgtRS(fld)
       
            ' Loop through target table
            tgtRS.MoveFirst
            Do Until tgtRS.EOF
            
               Debug.Print "tgt unique id: "; tgtRS(idFld)
               Set mvrs = mvfld.Value
               tgtRS.Edit
               
               ID = tgtRS(idFld) ' Current ID in the target
               ' Create source record set using temporary query defintion (name = "")
               srcQry = "SELECT " & srcTbl & "." & fld & " FROM " & srcTbl & " LEFT JOIN " & tgtTbl & " ON " & srcTbl & "." & idFld & "=" & tgtTbl & "." & idFld & " WHERE " & srcTbl & "." & idFld & " = '" & ID & "';"
               Set srcQdf = db.CreateQueryDef("", srcQry)
               Set srcRS = srcQdf.OpenRecordset
               
               If srcRS.EOF Then
                  Debug.Print " > no value in source"
                        
               Else
                  Debug.Print " > src value:"; srcRS(fld).Value
                  If srcRS(fld).Value <> "" Then
                     'Parse csv into array
                     csv = Split(srcRS(fld).Value, ",")
                     'Add values from source one by one
                     For Each v In csv
                           Debug.Print "  > Adding: "; v
                           mvrs.AddNew
                           mvrs("Value") = v
                           mvrs.Update
                     Next
                  End If
               End If
                    
               mvrs.Close
               tgtRS.Update
               
            tgtRS.MoveNext
            Loop
    Next
    
    ' Cleanup
    srcRS.Close
    tgtRS.Close
    db.Close
    Debug.Print "done"
End Sub