Sub Macro1()
Dim oPara As Paragraph
Dim oRng As Range, oLink As Range
Dim i As Long, j As Long, k As Long, m As Long
Dim vPara As Variant
Dim sText As String
For i = 1 To ActiveDocument.Paragraphs.Count
        Set oRng = ActiveDocument.Paragraphs(i).Range
        oRng.End = oRng.End - 1
        sText = ""
        vPara = Split(oRng.Text, Chr(44))
        j = UBound(vPara) - 1
        For k = 0 To j - 1
            sText = sText & vPara(k)
            If k < j - 1 Then sText = sText & Chr(44)
        Next k
        If j = 0 Then
            sText = vPara(j) & Chr(44)
        Else
            sText = sText & " and" & vPara(j) & Chr(44)
        End If
        Set oLink = ActiveDocument.Paragraphs(i).Range
        oLink.End = oLink.End - 1
        m = InStrRev(oLink, Chr(44))
        oLink.MoveStart wdCharacter, m
        oLink.Copy
        oRng.Text = sText
        oRng.Collapse 0
        oRng.Paste
    Next i
End Sub