Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, bSvd As Boolean
With ActiveDocument
  bSvd = .Saved
  j = .ComputeStatistics(wdStatisticWords)
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "[“" & Chr(34) & "]*[" & Chr(34) & "”]"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchWildcards = True
      .Execute
    End With
    Do While .Find.Found
      i = i + .ComputeStatistics(wdStatisticWords)
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
    MsgBox "This document contains " & j & " words ," & vbCr & _
      "of which " & i & " (" & Format(i * 100 / j, "0.00") & _
      "%) are in quotes."
  End With
  .Saved = bSvd
End With
Application.ScreenUpdating = True
End Sub