Ограничить длину строк в тексте

Function alignByWidth(Stri As String, w As Integer) As String()
Dim Res() As String
Dim Ws()  As String
Dim Bl()  As Integer
 
    ReDim Ws(1 To w) As String
    ReDim Bl(1 To w) As Integer
 
    Tmp = Split(Stri$, " ")
 
    sz% = 100 '::: Начальный размер строкового буфера
 
    ir% = 1
    ReDim Res(1 To sz%) As String
    
    iw% = 0
    ww% = 0
    
    For i% = 0 To UBound(Tmp)
        
        wd$ = CStr(Tmp(i%))
        
        If Len(wd$) > 0 Then
        
           ww% = ww% + Len(wd$) + 1
           
           If ww% > w Then
           
              s_b% = 0
              s_w% = 0
              Bl(iw%) = 0
              
              For j% = 1 To iw%
                  s_b% = s_b% + Bl(j%)
                  s_w% = s_w% + Len(Ws(j%))
              Next j%
           
              df% = w - s_w% - s_b%
              
              ii% = 1
              Do
              
                 Bl(ii%) = Bl(ii%) + 1
                 df% = df% - 1
                 If df% = 0 Then Exit Do
                 ii% = ii% + 1
                 If ii% = iw% Then ii% = 1
              
              Loop
           
              Buf$ = ""
           
              For ii% = 1 To iw%
                  Buf$ = Buf$ + Ws(ii%) + Space$(Bl(ii%))
              Next ii%
              
              Res(ir%) = Buf$
              ir% = ir% + 1
              
              If ir% > sz% Then
              
                 sz% = sz% + 100
                 
                 ReDim Preserve Res(1 To sz%) As String
              
              End If
              
              For ii% = 1 To w
                  Ws(iw%) = ""
                  Bl(iw%) = 0
              Next ii%
              
              Ws(1) = wd$
              Bl(1) = 1
              iw% = 1
              ww% = Len(wd$) + 1
           
           Else
           
              iw% = iw% + 1
              Ws(iw%) = wd$
              Bl(iw%) = 1
              
           End If
        
        End If
 
     Next i%
 
     If iw% >= 1 Then  '::: Чтобы не пропадало последнее слово (если оно единственное)
     
        Buf$ = ""
        For ii% = 1 To iw%
            Buf$ = Buf$ + Ws(ii%) + " "
        Next ii%
     
        Res(ir%) = Buf$
     
     End If
 
     ReDim Preserve Res(1 To ir%) As String
 
     alignByWidth = Res
 
End Function
 
Sub Test()
Dim X() As String
 
    Txt$ = "Однажды в студеную зимнюю пору я из лесу вышел. Был сильный мороз. Гляжу, поднимается медленно в гору" + _
           " лошадка, везущая хворосту воз."
        
    X = alignByWidth(Txt$, 45)
    
    For i% = 1 To UBound(X)
        Debug.Print X(i%)
    Next i%
    
End Sub

 Bl(ii%) = Bl(ii%) + 1

' определяем наличие vbCrLf
objRegExp.Pattern = "vbCrLf"  '
Set objMatches = objRegExp.Execute(MyString) '

количество vbCrLf в тексте: 
objMatches.Count
 
все позиции vbCrLf
от первой - FirstPos = objMatches.Item(0).FirstIndex ' 
до последней - LastPos = objMatches.Item( - 1).FirstIndex '