Sub AddQuotesDouble()
' Paul Beverley - Version 06.06.22
' Adds quotes round a word or phrase

' doubles
myOpen = ChrW(8220)
myClose = ChrW(8221)

myEnd = Selection.End
If Selection = "." Then Selection.MoveLeft , 1
Selection.Collapse wdCollapseStart
Selection.Expand wdWord
Selection.Collapse wdCollapseStart
Selection.TypeText myOpen
Selection.Start = myEnd
Selection.Expand wdWord
Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
  Selection.MoveEnd , -1
  DoEvents
Loop
Selection.Collapse wdCollapseEnd
Selection.TypeText myClose
End Sub