Sub Demo4()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Set DocTgt = ActiveDocument: Set DocSrc = Documents.Open(FileName:="C:\Text-To-MsWord\Sample.txt", AddToRecentFiles:=False, Visible:=False)
With DocSrc
  With .Range
    With .Find
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Text = "[^13]"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "[^13]{2}[!^13]*[^13]{2}"
      .Replacement.Text = "^p"
      .Execute
    End With
    If .Find.Found = True Then
      DocTgt.Range.Characters.Last.Text = Replace(.Text, vbCr & vbCr, "")
    End If
  End With
  .Close False
End With
Application.ScreenUpdating = True
End Sub

Option Explicit

Public Type SearchResults
    BlankLineNumber As Long
    CharPosition As Long
    StrLen As Long
End Type

Sub Example()
    Dim MySearch() As SearchResults, i As Long, txtToSrch As String
    
    txtToSrch = "[^13]"
    
    MySearch = GetSearchResults_2("C:\Text-To-MsWord\Sample.txt", txtToSrch, vbTextCompare)
    
    For i = 0 To UBound(MySearch)
        With MySearch(i)
            MsgBox "Blank Lines Are At " & vbCrLf & .BlankLineNumber
        End With
    Next
    
End Sub

Function GetSearchResults_2(FileFullName As String, FindThis As String, Optional CompareMethod As VbCompareMethod = vbBinaryCompare) As SearchResults()
  
    Dim fso As New FileSystemObject, s As String, pos As Long, l As Long, sr As SearchResults, ret() As SearchResults, i As Long
    Dim blnkLineNo As Long
    
    With fso.OpenTextFile(FileFullName)
        Do Until .AtEndOfStream
              l = l + 1
              s = .ReadLine
            pos = 1
            Do
                pos = InStr(pos, s, FindThis, CompareMethod)
                If pos > 0 Then
                    sr.CharPosition = pos
                    sr.BlankLineNumber = l
                    sr.StrLen = Len(FindThis)
                    
                    ReDim Preserve ret(i)
                    ret(i) = sr
                    i = i + 1
                    pos = pos + 1
                End If
            Loop Until pos = 0
        Loop
    End With
    GetSearchResults_2 = ret
End Function