Sub SourcesExport()
Dim oSrc As Source, StrSrc As String
With ActiveDocument
  .Range.Text = vbNullString
  For Each oSrc In Application.Bibliography.Sources
    StrSrc = StrSrc & vbCr & oSrc.XML
  Next
  .Range.InsertAfter StrSrc
  .Paragraphs.First.Range.Delete
End With
End Sub
 
Sub SourcesImport()
Dim i As Long
'In case the source is already present
On Error Resume Next
With ActiveDocument
  For i = 0 To UBound(Split(.Range.Text, vbCr))
    Application.Bibliography.Sources.Add Split(.Range.Text, vbCr)(i)
  Next
End With
End Sub

Sub DeleteReferenceBuilingBlocks()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim i As Long, iRng As Long, StrCode As String
Dim Stry As Range, Rng As Range, Fld As Field, Stl As String
With ActiveDocument
  For Each Stry In .StoryRanges
    Select Case Stry.StoryType
      Case wdFootnotesStory, wdEndnotesStory, wdMainTextStory
        'loop through all fields, starting from the end of the story
        For i = Stry.Fields.Count To 1 Step -1
          With Stry.Fields(i)
            'get the field type
            If .Type = wdFieldCitation Then
              StrCode = Trim(.Code.Text)
              Set Rng = .Result.Duplicate
              iRng = Len(Rng.Text)
              .Select
              WordBasic.BibliographyCitationToText
              Rng.MoveEnd wdCharacter, iRng
              If Rng.Characters.First.Previous = " " Then
                Rng.Start = Rng.Start - 1
              End If
              Set Fld = Rng.Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
                Text:="REF " & StrCode, Preserveformatting:=False)
              Fld.Code.Text = Trim(Replace(Fld.Code.Text, "REF ", ""))
            ElseIf .Type = wdFieldBibliography Then
              StrCode = Trim(.Code.Text)
              Set Rng = .Result.Duplicate
              With Rng
                .MoveStart wdParagraph, -2
                Stl = .Paragraphs(1).Style
                .Start = .Start - 1
                .End = .End + 2
                .Text = vbNullString
                .Collapse wdCollapseStart
                .Text = vbCr & "Bibliography" & vbCr
                .Paragraphs(2).Style = Stl
                .Collapse wdCollapseEnd
              End With
              Set Fld = Rng.Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
                Text:=StrCode, Preserveformatting:=False)
            End If
          End With
        Next
        Stry.Fields.Update
      Case Else
    End Select
  Next
End With
Set Rng = Nothing: Set Fld = Nothing
Application.DisplayAlerts = wdAlertsAll
Application.ScreenUpdating = True
End Sub