Macro to extract Word content control TITLES

Hello,

I am working with a macro that extracts the content of form fields (2007 content controls) to a delimited text file for later import to Excel. I would like to enhance the macro so that it also extracts the titles (or tags) from the content controls to serve essentially as column headers in the new Excel document. The current macro is below. Could you please help with some additional syntax that will perform this function?
Thanks!

Kirsten

Sub ExtractDataFromContentControls()
Dim DocList As String
Dim DocDir As String
Dim objCC As Range
Dim oForm As Document
Dim TargetDoc As Document
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
On Error GoTo err_FolderContents
With fDialog
.Title = "Select folder containing the completed form documents and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
If Right(DocDir, 1) <> "\" Then DocDir = DocDir + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Application.ScreenUpdating = False
DocList = Dir$(DocDir & "*.docx")
Set TargetDoc = Documents.Add
TargetDoc.SaveAs FileName:="DataDoc.txt", _
FileFormat:=wdFormatText
Do While DocList <> ""
WordBasic.DisableAutoMacros 1
Set oForm = Documents.Open(DocDir & DocList)
With oForm
For i = 1 To .ContentControls.Count
Set objCC = .ContentControls(i).Range
TargetDoc.Range.InsertAfter objCC
If i <> .ContentControls.Count Then
TargetDoc.Range.InsertAfter "^ "
End If
Next i
TargetDoc.Range.InsertAfter vbCr
End With
oForm.Close SaveChanges:=wdDoNotSaveChanges
TargetDoc.Save
DocList = Dir$()
WordBasic.DisableAutoMacros 0
Loop
Application.ScreenUpdating = True
Exit Sub
err_FolderContents:
MsgBox Err.Description
WordBasic.DisableAutoMacros 0
End Sub