Here is the updated code that can hyphenate the words if the words are greater than certain length (passed as parameter):
Code:
' ----------------------------------------------------------------
' Procedure Name: SplitString
' Purpose: To restructure long lext into shorter strings of
' less or equal to some specified length keeping full words
' and punctuation.
' Parameter strToSplit (String): The long text string to be shortened
' Parameter intMaxLen (Integer): The max length of shortened string
' Author: Jack
' Date: 29-Nov-18
' Modified by: Pac-man
' Date: 09-May-23
' Modifications: Change to function, Added Hypheantion option, put optional output type to string/array, removed adding space during
' the procedure which results of additional space at the end of each line due to which no of chr per line increased
' causing moving new word into new line which could have been put in current line
' ----------------------------------------------------------------
Function SplitString(strToSplit As String, intMaxLen As Integer, Optional intMinWordLenForHyphen As Integer = 0, Optional intMinChrAfterHyphen As Integer = 0, Optional OutputResultAs As ssOutputAs = oaString) As Variant
On Error GoTo Err_Handler
'Parameters and Meaning
'strToSplit As String - this is the long text field to whittle down
'intMaxLen As Integer - this is the max line length of short comment
'intMinWordLenForHyphen As Integer - Minimum word len to hyphenate (words less than this value will move to new line)
'intMinChrAfterHyphen as Integer - Minimum no of character that are mandatory for hyphenated word to have in the line
'Local Variables
Dim varArray As Variant 'will hold individual words
Dim varTemp() As Variant
Dim itm As Variant
Dim strTemp As String ' the working string
Dim intTemp As Integer ' utility integer
'Remove all " " double spaces
strTemp = strToSplit ' the incoming string to split
Do While InStr(strTemp, " ") > 0
strTemp = Replace(strTemp, " ", " ")
Loop
'Remove all vbCrLf line breaks
strTemp = strToSplit
Do While InStr(strTemp, vbCrLf) > 0
strTemp = Replace(strTemp, vbCrLf, " ")
Loop
'Split string to array
varArray = Split(strTemp, " ")
'Create strings of max or shorter length keeping full words
strTemp = "": ReDim varTemp(1 To 1)
For intTemp = 0 To UBound(varArray)
If strTemp <> "" Then
strTemp = strTemp & " " & varArray(intTemp)
ElseIf strTemp = "" Then
strTemp = varArray(intTemp)
End If
If intTemp = UBound(varArray) Then 'are we finished yet?
varTemp(UBound(varTemp)) = strTemp
strTemp = ""
Exit For
End If
If Len(strTemp & varArray(intTemp + 1)) + 1 > intMaxLen Then
'Hyphenate if hyphenateLen is greater than 0
If (intMinWordLenForHyphen <= 0) Or (Len(varArray(intTemp + 1)) < intMinWordLenForHyphen) Then
StartNewLine:
'Do Nothing and start new line
intTemp = intTemp
If IsEmpty(varTemp(UBound(varTemp))) Then
ReDim Preserve varTemp(1 To UBound(varTemp) + 1)
varTemp(UBound(varTemp) - 1) = strTemp
strTemp = ""
End If
Else
'hyphenate the next words
Dim hyphenatedWord As String
hyphenatedWord = left(varArray(intTemp + 1), Len(varArray(intTemp + 1)) - (2 + Len(strTemp & varArray(intTemp + 1)) - (intMaxLen))) & "-" 'hyphenate the next word
If (Len(hyphenatedWord) < intMinChrAfterHyphen + 1) Or (Trim(hyphenatedWord) = "-") Then GoTo StartNewLine
'assign new value to next word by removing the characters added into current line
varArray(intTemp + 1) = Mid(varArray(intTemp + 1), Len(hyphenatedWord))
strTemp = strTemp & " " & hyphenatedWord
GoTo StartNewLine
End If
Else
intTemp = intTemp
End If
Next intTemp
If OutputResultAs = oaArray Then
SplitString = varTemp
ElseIf OutputResultAs = oaString Then
strTemp = vbNullString
For intTemp = LBound(varTemp) To UBound(varTemp)
If Len(strTemp) = 0 Then strTemp = varTemp(intTemp) Else strTemp = strTemp & vbCrLf & varTemp(intTemp)
Next intTemp
SplitString = strTemp
End If
Exit_Handler:
Exit Function
Err_Handler:
Select Case Err.Number
Case Else
MsgBox "The following error has occured:" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: " & sModName & "\SplitString" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl), _
vbOKOnly + vbCritical, "An Error has Occured!"
Resume Exit_Handler
End Select
End Function
