Sub GoogleFetchQuotesEgypt()
' Paul Beverley - Version 30.08.23
' Launches selected text - with quotes - on Google

mySite = "http://www.google.com.eg/search?q="

If Selection.Start = Selection.End Then
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
Else
  endNow = Selection.End
  startNow = Selection.Start
  Selection.End = endNow
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
End If

mySubject = Trim(Selection)
mySubject = Replace(mySubject, vbCr, "")
mySubject = Replace(mySubject, " ", "+")
mySubject = Replace(mySubject, "&", "%26")
mySubject = "%22" & mySubject & "%22"
ActiveDocument.FollowHyperlink Address:=mySite & mySubject
Selection.Collapse wdCollapseEnd
End Sub