PopulateMultiValue.vba 2.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  1. Sub PopulateMultiValue()
  2. Dim db As DAO.Database
  3. Dim srcTbl As String: srcTbl = "ExtraLoad" ' Source table name
  4. Dim srcRS As DAO.Recordset2
  5. Dim srcQry As String
  6. Dim srcQdf As DAO.QueryDef
  7. Dim csv() As String
  8. Dim csvString As String
  9. Dim csvSize As Integer
  10. Dim tgtTbl As String: tgtTbl = "inventory2" ' Target table name
  11. Dim tgtRS As DAO.Recordset2
  12. Dim idFld As String: idFld = "[Unique ID]" ' Field to join the src with tgt table
  13. Dim ID As String
  14. Dim flds() As String: flds = Split("[Used in Site],[Supplier Name],[Integrator Name],[Hosting Partner Name]", ",")
  15. 'Dim flds() As String: flds = Split("[Used in Site]", ",")
  16. Dim fld As Variant
  17. Dim mvfld As DAO.Field2 ' Multi-value record set
  18. Dim mvrs As DAO.Recordset2 ' Multi-value field
  19. ' Open source and target
  20. Debug.Print "Start "; Format(Now(), "yyyy-MM-dd hh:mm:ss")
  21. Set db = CurrentDb()
  22. Set srcRS = db.OpenRecordset(srcTbl)
  23. Set tgtRS = db.OpenRecordset(tgtTbl)
  24. For Each fld In flds
  25. Debug.Print "**********Begin with field: "; fld
  26. Set mvfld = tgtRS(fld)
  27. ' Loop through target table
  28. tgtRS.MoveFirst
  29. Do Until tgtRS.EOF
  30. Debug.Print "tgt unique id: "; tgtRS(idFld)
  31. Set mvrs = mvfld.Value
  32. tgtRS.Edit
  33. ID = tgtRS(idFld) ' Current ID in the target
  34. ' Create source record set using temporary query defintion (name = "")
  35. srcQry = "SELECT " & srcTbl & "." & fld & " FROM " & srcTbl & " LEFT JOIN " & tgtTbl & " ON " & srcTbl & "." & idFld & "=" & tgtTbl & "." & idFld & " WHERE " & srcTbl & "." & idFld & " = '" & ID & "';"
  36. Set srcQdf = db.CreateQueryDef("", srcQry)
  37. Set srcRS = srcQdf.OpenRecordset
  38. If srcRS.EOF Then
  39. Debug.Print " > no value in source"
  40. Else
  41. Debug.Print " > src value:"; srcRS(fld).Value
  42. If srcRS(fld).Value <> "" Then
  43. 'Parse csv into array
  44. csv = Split(srcRS(fld).Value, ",")
  45. 'Add values from source one by one
  46. For Each v In csv
  47. Debug.Print " > Adding: "; v
  48. mvrs.AddNew
  49. mvrs("Value") = v
  50. mvrs.Update
  51. Next
  52. End If
  53. End If
  54. mvrs.Close
  55. tgtRS.Update
  56. tgtRS.MoveNext
  57. Loop
  58. Next
  59. ' Cleanup
  60. srcRS.Close
  61. tgtRS.Close
  62. db.Close
  63. Debug.Print "done"
  64. End Sub