• Home
 · 
• String Manipulation
 · 
• This code will easily break a multiline text box into a string array. It works much easier than all

This code will easily break a multiline text box into a string array. It works much easier than all

This code will easily break a multiline text box into a string array. It works much easier than all others found on the net so far. Enjoy.

API Declarations


Dim multi(12) As String



Rate This code will easily break a multiline text box into a string array. It works much easier than all

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'Other than that, here you go.  This will store the broken apart strings into
'the multi array.  You can change the size if you like, could probably even do
'it dynamically if needed.

Private Function convertText(str As String, maxLen As Integer)
    Dim strCount As Integer
    Dim pos As Long
    Dim endPos As Long
    Dim tempStr As String
    
    strCount = 0
    pos = 1
    
    While pos < Len(str)
        strCount = strCount + 1
        If Len(Mid(str, pos)) - 1 > maxLen Then
        'The lenght of the remaining string is greater
        'than the maximum lenght then
            
            If InStr(pos, str, vbCr) > (maxLen + pos) Then
            'An enter character was found but it exceeded
            'The length
                If InStr(pos, str, " ") = (maxLen + pos) Then
                    'If there is a blank at the proper
                    'position then set the string
                    multi(strCount) = Mid(str, pos, maxLen)
                    pos = pos + maxLen
                Else
                    'Must work backwards until a space
                    'is found
                    If InStr(pos, str, " ") > (pos + maxLen) Then
                    'If the string's space is after the
                    'maximum length then cut the string
                        multi(strCount) = Mid(str, pos, maxLen)
                        pos = pos + maxLen
                    Else
                    'Work back words from the position
                        endPos = maxLen
                        While Not (Mid(str, endPos, 1) = " ")
                            endPos = endPos - 1
                        Wend
                        multi(strCount) = Mid(str, pos, endPos)
                        pos = pos + endPos
                    End If
                End If
            ElseIf InStr(pos, str, vbCr) < (maxLen + pos) And (InStr(pos, str, vbCr) > 1) Then
                'if enter character found
                'from a string less than maxlen
                multi(strCount) = Mid(str, pos, (InStr(pos, str, vbCr) - pos))
                pos = InStr(pos, str, vbCr) + 2
            Else
                'This would be if no enter signs were encountered
        
                If InStr(pos, str, " ") > (pos + maxLen) Then
                'If the string's space is after the
                'maximum length then cut the string
                    multi(strCount) = Mid(str, pos, maxLen)
                    pos = pos + maxLen
                ElseIf InStr(pos, str, " ") < (pos + maxLen) Then
                'Work back words from the position
                    endPos = maxLen
                    While (Not (Mid(str, endPos, 1) = " "))
                        endPos = endPos - 1
                    Wend
                    multi(strCount) = Mid(str, pos, endPos)
                    pos = pos + endPos
                Else
                    MsgBox ("Some condition wasn't met")
                End If
        
            End If
        Else
            While pos < Len(str)
                If InStr(pos, str, vbCr) Then
                    tempStr = Mid(str, pos, InStr(pos, str, vbCr) - pos)
                    multi(strCount) = tempStr
                    pos = InStr(pos, str, vbCr) + 2
                Else
                    multi(strCount) = Mid(str, pos, Len(str))
                    pos = Len(str)
                End If
            Wend
        End If
    Wend

End Function