Public Function LoopString2(ByVal strIN As String, ByVal MaxLineLen As Long) As String
Dim strOut As String
Dim LinesCol As Collection
strIN = ClearDoubleSpaces(strIN)
strIN = RemoveLineBreaks(strIN, " ")
'?: Call first RemoveLineBreakes and then ClearDoubleSpaces?
Set LinesCol = GetLines(strIN, MaxLineLen)
strOut = JoinStringCollection(LinesCol, vbNewLine)
LoopString2 = strOut
End Function
Private Function GetLines(ByVal strIN As String, ByVal MaxLineLen As Long) As Collection
Dim strLeftOver As String
Dim LinesCol As Collection
Set LinesCol = New Collection
strLeftOver = strIN
Do Until Len(strLeftOver) = 0
LinesCol.Add GetNextLine(strLeftOver, MaxLineLen)
Loop
Set GetLines = LinesCol
End Function
Private Function GetNextLine(ByRef strLeftOver As String, ByVal MaxLineLen As Long) As String
Dim strA As String, strB As String
If Len(strLeftOver) < MaxLineLen Then
GetNextLine = strLeftOver
'strLeftOver = Right(strLeftOver, Len(strLeftOver) - Len(strLeftOver)) '!: Len(strLeftOver) - Len(strLeftOver) = 0 =>
strLeftOver = vbNullString
Else
strA = Mid(strLeftOver, 1, MaxLineLen)
strB = Mid(strA, 1, InStrRev(strA, " "))
'strB = Mid(strLeftOver, 1, InStrRev(strLeftOver, " ", MaxLineLen)) ' should be the same
'!: Bug: if a word is greather then MaxLineLen => empty line => endless loop
GetNextLine = strB
strLeftOver = Right(strLeftOver, Len(strLeftOver) - Len(strB))
End If
End Function
Private Function JoinStringCollection(ByVal StringCollection As Collection, Optional ByVal Delimiter As String = vbNewLine) As String
Dim strOut As String
Dim varItem As Variant
For Each varItem In StringCollection
'Debug.Print varItem
strOut = strOut & varItem & vbNewLine '?: end with vbnewline?
Next
JoinStringCollection = strOut
End Function
Private Function ClearDoubleSpaces(ByVal StringToClear As String) As String
Const Quote As String = " "
Do While InStr(StringToClear, Quote & Quote) > 0
StringToClear = Replace(StringToClear, Quote & Quote, Quote)
Loop
ClearDoubleSpaces = StringToClear
End Function
Private Function RemoveLineBreaks(ByVal StringToClear As String, Optional ByVal ReplacementString As String = " ") As String
RemoveLineBreaks = Replace(StringToClear, vbNewLine, ReplacementString)
'?: do it also with vbCr and/or vbLf?
End Function
