I have repeated my code with annotation and restricted the called sub to convert only English smart quotes. I am not processing ranges twice. I am processing ranges within ranges, such as text boxes in the header/footer which require a touch of brute force.
Code:
Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 23 Nov 2021
Sub ReplaceInStoryRanges()
Const sPath As String = "C:\Path\docname.docx" ' the path of the document
Dim WordDoc As Object
Dim wdApp As Object
Dim oStory As Object
Dim oShp As Object
Dim bFormat As Boolean
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set WordDoc = wdApp.Documents.Open(sPath) 'works in Word even if the document is already open
'record autoformat option
bFormat = wdApp.Options.AutoFormatAsYouTypeReplaceQuotes
'set autoformat option to off
wdApp.Options.AutoFormatAsYouTypeReplaceQuotes = False
'process each storyrange by enumeration
For Each oStory In WordDoc.StoryRanges
Select Case oStory.StoryType
Case 1 To 11 'the principle storyranges
'see https://apireference.aspose.com/words/net/aspose.words/storytype)
Do
ReplaceQuotes wdApp, WordDoc, oStory 'run the external sub
DoEvents
On Error GoTo 0
Select Case oStory.StoryType
Case 6, 7, 8, 9, 10, 11 'header/footer ranges
'process text boxes etc in the header/footer ranges separately
If oStory.ShapeRange.Count > 0 Then
For Each oShp In oStory.ShapeRange
If oShp.TextFrame.HasText Then
ReplaceQuotes wdApp, WordDoc, oStory 'run the external sub
End If
DoEvents
Next oShp
End If
Case Else
End Select
On Error GoTo 0
Set oStory = oStory.NextStoryRange
Loop Until oStory Is Nothing
Case Else
End Select
DoEvents
Next oStory
'restore original autoformat option
wdApp.Options.AutoFormatAsYouTypeReplaceQuotes = bFormat
End Sub
Sub ReplaceQuotes(wdApp As Object, oDoc As Object, oRng As Object)
Dim oFind As Object
Dim vFindText As Variant
Dim vReplText As Variant
Dim bQuotes As String
Dim i As Long
vFindText = Array(Chr(147), Chr(148), Chr(145), Chr(146))
vReplText = Array(Chr(34), Chr(34), Chr(39), Chr(39))
For i = LBound(vFindText) To UBound(vFindText)
Set oFind = oRng.Duplicate
With oFind.Find
Do While .Execute(vFindText(i))
oFind.Text = vReplText(i)
oFind.Collapse 0
Loop
End With
Next i
lbl_Exit:
Set oFind = Nothing
Exit Sub
End Sub