Removing paragraphs length 5 from word document usin VBA

I have put together this code to remove blanks lines and it works.
But it remove all blanks line
What I want to do is remove a blank line if there are block of 5 blanks lines
If I change the value If Len(oPara.Range.Text) = 5 Then the VBA macro fails.
It also fails if I set it to 2...

Any suggestions???

Thanks



Sub Pararemove()

Dim sPath As String
Dim WdDoc As Document, sFile As String
Dim sCellText As String
Dim strFilename As String
Dim oPara As Paragraph


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'Change the path below to suit your need
sPath = "\c:Deanj\Academy_Test - Copy1\"

sFile = Dir(sPath & "*.doc")

'Loop through all .doc files in that path
Do While sFile <> ""
Set WdDoc = Application.Documents.Open(sPath & sFile)
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.Text) = 1 Then
oPara.Range.Delete
End If
Next
If ActiveDocument.Saved = False Then ActiveDocument.Save
sFile = Dir
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub