Sub FootnotePunctBefore()
Application.ScreenUpdating = False
Dim FtNt As Footnote, Rng As Range, Fld As Field
With ActiveDocument
  For Each FtNt In .Footnotes
    Set Rng = FtNt.Reference
    With Rng
      'Eliminate any spaces before the footnote
      Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
        .Characters.First.Previous.text = vbNullString
      Loop
      'Swap the footnote/punctuation, as applicable
      Do While .Characters.Last.Next Like "[!0-9A-Za-z]"
        .InsertBefore .Characters.Last.Next
        .Characters.Last.Next.Delete
      Loop
    End With
  Next
  For Each Fld In .Range.Fields
    With Fld
      If .Type = wdFieldNoteRef Then
        'Swap the footnote/punctuation, as applicable
        With .Result
          Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
            .Characters.First.Previous.text = vbNullString
          Loop
          'Swap the footnote/punctuation, as applicable
          Do While Not .Characters.Last.Next Like "[0-9A-Za-z]"
            .InsertBefore .Characters.Last.Next
            .Characters.Last.Next.Delete
          Loop
        End With
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub