Sub CommentAddFromFile()
' Paul Beverley - Version 04.07.24
' Adds a comment from a file of ready-made comments

myPartFilename = "hapter"
myMarker = "|"
deleteHeader = True

Selection.Expand wdParagraph
Selection.MoveEnd , -1
If deleteHeader = True Then
  colonPos = InStr(Selection, ": ")
  If colonPos > 0 Then Selection.MoveStart , colonPos + 1
End If
Selection.Copy
markerPos = InStr(Selection.Text, myMarker)
moveCursor = Len(Selection) - markerPos
gottaDoc = False
For Each myDoc In Documents
  myName = myDoc.Name
  If InStr(myName, myPartFilename) > 0 Then
    gottaDoc = True
    Exit For
  End If
Next myDoc
If gottaDoc = False Then
  Beep
  myResponse = MsgBox("Can't find a file with part name:" & _
       vbCr & vbCr & myPartFilename, vbOKOnly, "CommentAddFromFile")
  Exit Sub
End If
myDoc.Activate
If Selection.start = Selection.End Then
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
  Set rng = Selection.Range.Duplicate
  rng.Collapse wdCollapseEnd
  rng.MoveEnd , 1
  If rng.Text = "-" Then Selection.MoveEnd wdWord, 2
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
Else
  endNow = Selection.End
  Selection.MoveLeft wdWord, 1
  startNow = Selection.start
  Selection.End = endNow
  Selection.Expand wdWord
  Do While InStr(ChrW(8217) & "' ", Right(Selection.Text, 1)) > 0
    Selection.MoveEnd , -1
    DoEvents
  Loop
  Selection.start = startNow
End If

Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range)
Selection.Paste
ActiveDocument.ActiveWindow.View.SplitSpecial = wdPaneNone
cmt.Edit
If markerPos > 0 Then
  Selection.MoveLeft , moveCursor
  Selection.MoveStart , -1
  Selection.Delete
End If
End Sub