I am inexperienced with VBA, mainly pasting code. I realise problems with multivalue fields and am stuck. Code worked previously
'Loop Through A Table With A Multi-Value Field and Insert Values Into the Multi-Value Field From a Parsed Regular Text Field.
'ENTRY is the table and holds both string to be converted and multi-valued field (both short text fields)
'CLASSNUMBER is the multivalue field
'STRINGFIELD is the field with string of the combined, comma-separated values
Option Compare Database
Option Explicit
Option Base 1
Dim strInputString As String
Dim intNumberOfArrayEntries As Integer
Dim strStateArray(50) As String
Public Function InsertIntoMultiField()
Dim db As DAO.Database
' ************************************************** *********************
' Main recordset containing both a multi-value field and string field
' ************************************************** *********************
Dim rsENTRY As DAO.Recordset2
' ************************************************** *********************
' Now Define the Multi-Value Fields as a RecordSet
' ************************************************** *********************
Dim rsCLASSNUMBER As DAO.Recordset2
' ************************************************** *********************
' The Values of the Field Are Contained in a Field Object
' Dim fldCLASSNUMBERTemp As DAO.Field2
' ************************************************** *********************
Dim fldCLASSNUMBER As DAO.Field2
Dim I As Integer
' ************************************************** *********************
' Open the Parent File
' ************************************************** *********************
Set db = CurrentDb()
Set rsENTRY = db.OpenRecordset("ENTRY")
' ************************************************** *********************
' Set The Multi-Value Field
' ************************************************** *********************
Set fldCLASSNUMBER = rsENTRY("CLASSNUMBER")
' ************************************************** *********************
' Check to Make Sure it is Multi-Value
' ************************************************** *********************
If Not (fldCLASSNUMBER.IsComplex) Then
MsgBox ("Not A Multi-Value Field")
rsENTRY.Close
Set rsENTRY = Nothing
Set fldCLASSNUMBER = Nothing
Exit Function
Else
'MsgBox ("Selected field IS a multi-value field")
End If
On Error Resume Next
' ************************************************** *********************
' Loop Through
' ************************************************** *********************
Do While Not rsENTRY.EOF
' ************************************************** *********************
' Parse Regular Text Field into Array For Insertion into Multi-Value
' ************************************************** *********************
strInputString = rsENTRY!Stringfield
Call ParseInputString
' ************************************************** *********************
' If Entries Are Present, Add Them To The Multi-Value Field
' ************************************************** *********************
If intNumberOfArrayEntries > 0 Then
Set rsCLASSNUMBER = fldCLASSNUMBER.Value
rsENTRY.Edit
For I = 1 To intNumberOfArrayEntries
rsCLASSNUMBER.AddNew
rsCLASSNUMBER("Value") = strStateArray(I)
rsCLASSNUMBER.Update
Next I
rsCLASSNUMBER.Close
rsENTRY.Update
End If
rsENTRY.MoveNext
Loop
On Error GoTo 0
rsENTRY.Close
Set rsENTRY = Nothing
Set rsCLASSNUMBER = Nothing
End Function
Public Function ParseInputString()
Dim intLength As Integer
Dim intStartSearch As Integer
Dim intNextComma As Integer
Dim intStartOfItem As Integer
Dim intLengthOfItem As Integer
Dim strComma As String
strComma = ","
intNumberOfArrayEntries = 0
strInputString = Trim(strInputString)
intLength = Len(strInputString)
' ************************************************** *********************
' Skip Zero Length Strings
' ************************************************** *********************
If intLength = 0 Then
Exit Function
End If
' ************************************************** *********************
' Strip Any Leading Comma
' ************************************************** *********************
If Mid(strInputString, 1, 1) = "," Then
Mid(strInputString, 1, 1) = " "
strInputString = Trim(strInputString)
intLength = Len(strInputString)
If intLength = 0 Then
Exit Function
End If
End If
' ************************************************** *********************
' Strip Any Trailing Comma
' ************************************************** *********************
If Mid(strInputString, intLength, 1) = "," Then
Mid(strInputString, intLength, 1) = " "
strInputString = Trim(strInputString)
intLength = Len(strInputString)
If intLength = 0 Then
Exit Function
End If
End If
intStartSearch = 1
' ************************************************** *********************
' Loop Through And Parse All the Items
' ************************************************** *********************
Do
intNextComma = InStr(intStartSearch, strInputString, strComma)
If intNextComma <> 0 Then
intNumberOfArrayEntries = intNumberOfArrayEntries + 1
intStartOfItem = intStartSearch
intLengthOfItem = intNextComma - intStartOfItem
strStateArray(intNumberOfArrayEntries) = Trim(Mid(strInputString, intStartOfItem, intLengthOfItem))
intStartSearch = intNextComma + 1
Else
intNumberOfArrayEntries = intNumberOfArrayEntries + 1
intStartOfItem = intStartSearch
intLengthOfItem = intLength - intStartSearch + 1
strStateArray(intNumberOfArrayEntries) = Trim(Mid(strInputString, intStartOfItem, intLengthOfItem))
End If
Loop Until intNextComma = 0
End Function
Data mismatch error on line 66 Set fldCLASSNUMBER = rsENTRY("CLASSNUMBER")
'Loop Through A Table With A Multi-Value Field and Insert Values Into the Multi-Value Field From a Parsed Regular Text Field.
'ENTRY is the table and holds both string to be converted and multi-valued field (both short text fields)
'CLASSNUMBER is the multivalue field
'STRINGFIELD is the field with string of the combined, comma-separated values
Option Compare Database
Option Explicit
Option Base 1
Dim strInputString As String
Dim intNumberOfArrayEntries As Integer
Dim strStateArray(50) As String
Public Function InsertIntoMultiField()
Dim db As DAO.Database
' ************************************************** *********************
' Main recordset containing both a multi-value field and string field
' ************************************************** *********************
Dim rsENTRY As DAO.Recordset2
' ************************************************** *********************
' Now Define the Multi-Value Fields as a RecordSet
' ************************************************** *********************
Dim rsCLASSNUMBER As DAO.Recordset2
' ************************************************** *********************
' The Values of the Field Are Contained in a Field Object
' Dim fldCLASSNUMBERTemp As DAO.Field2
' ************************************************** *********************
Dim fldCLASSNUMBER As DAO.Field2
Dim I As Integer
' ************************************************** *********************
' Open the Parent File
' ************************************************** *********************
Set db = CurrentDb()
Set rsENTRY = db.OpenRecordset("ENTRY")
' ************************************************** *********************
' Set The Multi-Value Field
' ************************************************** *********************
Set fldCLASSNUMBER = rsENTRY("CLASSNUMBER")
' ************************************************** *********************
' Check to Make Sure it is Multi-Value
' ************************************************** *********************
If Not (fldCLASSNUMBER.IsComplex) Then
MsgBox ("Not A Multi-Value Field")
rsENTRY.Close
Set rsENTRY = Nothing
Set fldCLASSNUMBER = Nothing
Exit Function
Else
'MsgBox ("Selected field IS a multi-value field")
End If
On Error Resume Next
' ************************************************** *********************
' Loop Through
' ************************************************** *********************
Do While Not rsENTRY.EOF
' ************************************************** *********************
' Parse Regular Text Field into Array For Insertion into Multi-Value
' ************************************************** *********************
strInputString = rsENTRY!Stringfield
Call ParseInputString
' ************************************************** *********************
' If Entries Are Present, Add Them To The Multi-Value Field
' ************************************************** *********************
If intNumberOfArrayEntries > 0 Then
Set rsCLASSNUMBER = fldCLASSNUMBER.Value
rsENTRY.Edit
For I = 1 To intNumberOfArrayEntries
rsCLASSNUMBER.AddNew
rsCLASSNUMBER("Value") = strStateArray(I)
rsCLASSNUMBER.Update
Next I
rsCLASSNUMBER.Close
rsENTRY.Update
End If
rsENTRY.MoveNext
Loop
On Error GoTo 0
rsENTRY.Close
Set rsENTRY = Nothing
Set rsCLASSNUMBER = Nothing
End Function
Public Function ParseInputString()
Dim intLength As Integer
Dim intStartSearch As Integer
Dim intNextComma As Integer
Dim intStartOfItem As Integer
Dim intLengthOfItem As Integer
Dim strComma As String
strComma = ","
intNumberOfArrayEntries = 0
strInputString = Trim(strInputString)
intLength = Len(strInputString)
' ************************************************** *********************
' Skip Zero Length Strings
' ************************************************** *********************
If intLength = 0 Then
Exit Function
End If
' ************************************************** *********************
' Strip Any Leading Comma
' ************************************************** *********************
If Mid(strInputString, 1, 1) = "," Then
Mid(strInputString, 1, 1) = " "
strInputString = Trim(strInputString)
intLength = Len(strInputString)
If intLength = 0 Then
Exit Function
End If
End If
' ************************************************** *********************
' Strip Any Trailing Comma
' ************************************************** *********************
If Mid(strInputString, intLength, 1) = "," Then
Mid(strInputString, intLength, 1) = " "
strInputString = Trim(strInputString)
intLength = Len(strInputString)
If intLength = 0 Then
Exit Function
End If
End If
intStartSearch = 1
' ************************************************** *********************
' Loop Through And Parse All the Items
' ************************************************** *********************
Do
intNextComma = InStr(intStartSearch, strInputString, strComma)
If intNextComma <> 0 Then
intNumberOfArrayEntries = intNumberOfArrayEntries + 1
intStartOfItem = intStartSearch
intLengthOfItem = intNextComma - intStartOfItem
strStateArray(intNumberOfArrayEntries) = Trim(Mid(strInputString, intStartOfItem, intLengthOfItem))
intStartSearch = intNextComma + 1
Else
intNumberOfArrayEntries = intNumberOfArrayEntries + 1
intStartOfItem = intStartSearch
intLengthOfItem = intLength - intStartSearch + 1
strStateArray(intNumberOfArrayEntries) = Trim(Mid(strInputString, intStartOfItem, intLengthOfItem))
End If
Loop Until intNextComma = 0
End Function
Data mismatch error on line 66 Set fldCLASSNUMBER = rsENTRY("CLASSNUMBER")
