Sub Macro1()
  Dim oRng As Range
  Dim strText As String
  Dim i As Long
      Set oRng = ActiveDocument.Range
      i = 1
      With oRng.Find
          Do While .Execute(FindText:=" {", _
                            MatchWildcards:=False)
              oRng.MoveEndUntil Chr(46)
              If oRng.Characters.Last = "}" Then
                  oRng.End = oRng.End + 1
                  ActiveDocument.Footnotes.Add oRng, CStr(i), oRng.Text
                  oRng.Text = ""
                  i = i + 1
              End If
              oRng.Collapse 0
          Loop
      End With
  lbl_Exit:
      Set oRng = Nothing
      Exit Sub
  End Sub