Import flower show class numbers into Entry table imultivalue field

[SandyBuchan]

I am inexperienced with VBA, 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

CLASSNUMBER is the multivalue field

STRINGFIELD is the field with string of the combined, comma-separated values



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

I am new to VBA and am stuck

[Gicu]

You don't say what happens when it "doesn't work". Are you getting errors (which ones, on which line), nothing happens (no errors but no data in multi-valued field), etc.

Do you have the variable strStateArray declared as a Public one at the top of the module? by the way the parsing code can be simplified a lot by using the built in Split() function.

Cheers,

[Welshgasman]

Please put anything more than a few lines of code within code tags. That preserves the indentation.

[SandyBuchan]

Line 76 of code returns data mismatch error

[Gicu]

And line 76 is????

[Micron]

This is how it should be done - if you want to maximize your chances of getting a solution:

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 '<< error 13;  "Data type mismatch" OR is it 3615; Data type mismatch in criteria expression??
   Exit Function
End If

Note the use of code tags. Without line numbers, it is anyone's guess as to which line you're talking about. I realize my example has nothing to do with the problem code. It's just an example of how to flag the problem line & indicates there is more than one error number with that message. So the number and error text is important in your posts.

[CJ_London]

crossposted here with answers
https://www.access-programmers.co.uk.../#post-1836567

[SandyBuchan]

is this better?
Public Function InsertIntoMultiField() '<<compile error:"expected:end of statement"

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") '<< error 13;compile error:"expected:end of statement"

' ************************************************** *********************
' 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

[Gicu]

Not really as you did not use the code tags (#) in the forum window and didn't include the line numbers so no way to know what line 76 is. And now you mention a different error...
Please review the example code in this link:
https://docs.microsoft.com/en-us/off...ld2-object-dao

Cheers,

[SandyBuchan]

Thanks. Learning all the time.
Not aware of toolbar function. Line 76 in immediate windows gives the compile error End of statement. If I run code from macro the error 13 is datamismatch

Public Function InsertIntoMultiField() '<<compile error:"expected:end of statement"

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") '<< error 13;compile error:"expected:end of statement"

' ************************************************** *********************
' 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

[Minty]

Let me fix that for you so it's not just a wall of un-formatted text;

Public Function InsertIntoMultiField() '<<compile error:"expected:end of statement"


    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") '<< error 13;compile error:"expected:end of statement"


    ' ************************************************** *********************
    ' 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

Function 2

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

Your error is probably because you either need to use

Set fldCLASSNUMBER = rsENTRY.Fields("CLASSNUMBER")

Or

Set fldCLASSNUMBER = rsENTRY!CLASSNUMBER

Not a syntax halfway between the two ?

[SandyBuchan]

thank you all for your patience and tuition
Soved as bug in updated version 2206 Access – Bug – .Fields Not Working Anymore | DEVelopers HUT (devhut.net).
At present using msaccess 2010 and evrything works