Function CountSpaces() As Integer
Dim doc As Document: Set doc = ActiveDocument
Dim rngFind As Range
      
    On Error GoTo EndOfSub
    Application.ScreenUpdating = False
    Call ClearFind
    
    If Selection.Type < 2 Then
        Set rngFind = doc.Range
    Else
        Set rngFind = Selection.Range
    End If
           
    CountSpaces = 0
    
    With rngFind
        With .Find
            .Text = "^32{2;}"
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
            .Execute
        End With
        Do While .Find.Found
            If Len(rngFind.Text) > CountSpaces Then _
                CountSpaces = Len(rngFind.Text)
            .End = .End + 1
            .Collapse wdCollapseEnd
            .Find.Execute
        Loop
    End With

EndOfSub:
End Function

Sub GetMaxSpaces()
Dim StrTxt As String, StrTmp As String, i As Long
StrTxt = ActiveDocument.Range.Text: StrTmp = " "
While InStr(StrTxt, StrTmp) > 0
    StrTmp = StrTmp & " "
    i = i + 1
Wend
MsgBox "The maximum space sequence is: " & i
End Sub

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, Rng As Range
Set Rng = ActiveDocument.Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Format = True
    .Style = "Normal"
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    If InStr(.Text, " ") > 0 Then
      i = GetMaxSpaces(.Text)
      If i > j Then j = i
    End If
    If .End = Rng.End Then Exit Do
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox "The maximum space sequence is: " & j
End Sub
 
Function GetMaxSpaces(StrTxt As String)
Dim StrTmp As String, i As Long
StrTmp = " "
While InStr(StrTxt, StrTmp) > 0
    StrTmp = StrTmp & " "
    i = i + 1
Wend
GetMaxSpaces = i
End Function