Sub ImportAutoCorrect()
    'This macro imports AutoCorrect entries that appear in a document file
    'Each paragraph in the source document to be imported/deleted should take the form: [content to appear in the "Replace:" column][tab character][content to appear in the "With:" column][hard return]
    'The content to appeear in the With column must be 255 or fewer characters in length
    'All other lines are ignored
    '
    'Written by Michael Schuler (https://bergerplusschuler.com)
  
    Dim iCounter As Integer
    Dim iLoop As Integer
    Dim sSel As String
    Dim docSource As Document
    Const sDialogTitle As String = "Import AutoCorrect Entries"
    
    On Error GoTo Err_Msg
    
    If MsgBox("Do you want to add document contents to your AutoCorrect library?", vbYesNo + vbQuestion, sDialogTitle) <> vbYes Then
        GoTo Macroend
    End If
    Application.ScreenUpdating = False
    Set docSource = ActiveDocument
    For iLoop = 0 To docSource.Range.Paragraphs.Count - 1
        Set rRange = docSource.Paragraphs(1).Next(Count:=iLoop).Range
        rRange.Select
        sSel = Selection.Text
        If InStr(sSel, Chr(9)) Then
            AutoCorrect.Entries.add Name:=Left(sSel, InStr(1, sSel, Chr(9)) - 1), value:=Mid(sSel, InStr(1, sSel, Chr(9)) + 1, Len(sSel) - InStr(1, sSel, Chr(9)) - 1)
            iCounter = iCounter + 1
        End If
    Next iLoop
    Selection.Collapse Direction:=wdCollapseEnd
    MsgBox iCounter & " AutoCorrect entries have been added.", vbInformation, sDialogTitle
     
Macroend:
    Application.ScreenUpdating = True
    Exit Sub

Err_Msg:
    If err.Number = 5854 Then
    MsgBox "The entry for " & Left(sSel, InStr(1, sSel, Chr(9)) - 1) & " is greater than 255 characters and is being skipped.", vbCritical, sDialogTitle
        Resume Next
    End If
    Application.ScreenUpdating = True
    MsgBox "The macro has encountered an error." & vbCrLf & err.Number & ": " & err.Description, vbCritical, sDialogTitle

End Sub


Sub DeleteAutoCorrect()
    'This macro deletes AutoCorrect entries that appear in a document file
    'This macro requires the function ExistsInCollection()
    'Each paragraph in the source document to be imported/deleted should take the form: [contents appearing in the "Replace:" column][tab character][contents appearing in the "With:" column][hard return]
    'All other lines are ignored
    '
    'Written by Michael Schuler (https://bergerplusschuler.com)
    
    Dim iLoop As Integer
    Dim iCounter As Integer
    Dim rRange As Range
    Dim docSource As Document
    Dim sSel As String
    Dim sName As String
    Const sDialogTitle As String = "Delete AutoCorrect Entries"
    
    On Error GoTo Err_Msg
    
    If MsgBox("Do you want to delete document contents from your AutoCorrect library?", vbYesNo + vbQuestion, sDialogTitle) <> vbYes Then
        GoTo Macroend
    End If

    Application.ScreenUpdating = False
    Set docSource = ActiveDocument
    For iLoop = 0 To docSource.Range.Paragraphs.Count - 1
        Set rRange = docSource.Paragraphs(1).Next(Count:=iLoop).Range
        rRange.Select
        sSel = Selection.Text
        If InStr(sSel, Chr(9)) Then
            sName = Left$(sSel, InStr(sSel, Chr(9)) - 1)
            If ExistsInCollection(AutoCorrect.Entries, sName) Then
                AutoCorrect.Entries(sName).Delete
                iCounter = iCounter + 1
            End If
        End If
    Next iLoop
    Selection.Collapse Direction:=wdCollapseEnd
    MsgBox iCounter & " AutoCorrect entries have been deleted.", vbExclamation, sDialogTitle

Macroend:
    Application.ScreenUpdating = True
Exit Sub

Err_Msg:
    Application.ScreenUpdating = True
    MsgBox "The macro has encountered an error." & vbCrLf & err.Number & ": " & err.description, vbCritical, sDialogTitle

End Sub

Public Function ExistsInCollection(col As Variant, key As Variant) As Boolean
' from https://stackoverflow.com/questions/137845/determining-whether-an-object-is-a-member-of-a-collection-in-vba
    
    On Error GoTo err
    ExistsInCollection = True
    IsObject (col.Item(key))
    Exit Function
    
err:
    ExistsInCollection = False
    
End Function