Capture content controls to Excel, handle various control types

[Cheesecube]

Hi, I have an existing script that retrieves all Content Controls from a Word Document and prints it into an Excel spreadsheet.

Currently it works for free text/rich text content control types but I need to extend this functionality to Checkbox types.

Ideally it will capture "True" or "False" depending whether the checkbox is ticked or not

Here is the existing code:


Sub ContentControlExtraction()
' VARIABLES FOR THIS WORKBOOK
Dim DocWorkbook As Workbook
Set DocWorkbook = Application.ActiveWorkbook
Dim DocSheet As Worksheet
Set DocSheet = DocWorkbook.ActiveSheet
DocSheet.Cells(1, 1).Value = "Field Name"
DocSheet.Cells(1, 2).Value = "Value"

' OPEN WORD DOCUMENT
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Dim WordDoc As Word.Document
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\test.docx")

Dim intNumContentControls As Integer
intNumContentControls = WordDoc.ContentControls.Count

' LOOP FOR EACH CONTENT CONTROL
Dim i As Integer
For i = 1 To intNumContentControls
DocSheet.Cells(i + 1, 1).Value = WordDoc.ContentControls(i).Title
DocSheet.Cells(i + 1, 2).Value = WordDoc.ContentControls(i).Range.Text
Next i

Debug.Print "NUMBER OF CONTENT CONTROLS: " & intNumContentControls

End Sub

How would you modify this code to work with Checkbox content controls?

I.e. if it is free text/rich text, just capture as it is, if it is checkbox type, translate it to "True" or "False"

Also, sometimes the form I am capturing uses Wingdings Character 254 (a tickbox) for Checked, instead of the standard 'X' box. Do take this into account

[gmaxey]

For i = 1 To intNumContentControls
DocSheet.Cells(i + 1, 1).Value = WordDoc.ContentControls(i).Title
If WordDoc.ContentControls(i).Type = 8 Then
If WordDoc.ContentControls(i).Checked Then
DocSheet.Cells(i + 1, 2).Value = "True"
Else
DocSheet.Cells(i + 1, 2).Value = "True"
End If
Else
DocSheet.Cells(i + 1, 2).Value = WordDoc.ContentControls(i).Range.Text
End If
Next i

[macropod]

This has been dealt with before. A simple forum search could have turned up:
http://www.vbaexpress.com/forum/showthread.php?59909-Word-Content-Control-Data-Import-to-Excel-Table
http://www.vbaexpress.com/forum/showthread.php?40406-Extracting-Word-form-Data-and-exporting-to-Excel-spreadsheet&p=257696&viewfull=1#post257696
and, further down in the same thread:
http://www.vbaexpress.com/forum/showthread.php?40406-Extracting-Word-form-Data-and-exporting-to-Excel-spreadsheet&p=291047&viewfull=1#post291047

[gmayor]

I am pretty sure what you meant to say was : ----



If WordDoc.ContentControls(i).Checked Then
DocSheet.Cells(i + 1, 2).Value = "True"
Else
DocSheet.Cells(i + 1, 2).Value = "False"
End If

[Cheesecube]

Hi, I want to search WordDoc.ContentControls for the ContentControl that has Title of "CompanyName", then extract the Text from that ContentControl, how do I do this efficiently? I.e. no looping if possible

[gmayor]

Assuming the content control exists and there is only one CC with that title in the document. The value would be something like


DocSheet.Cells(i + 1, 2).Value = WordDoc.SelectContentControlsByTitle("CompanyName").Item(1).Range.Text

[Cheesecube]

I modified the code a bit



For i = 1 To intNumContentControls DocSheet.Cells(i + 1, 1).Value = WordDoc.ContentControls(i).Title
If WordDoc.ContentControls(i).Type = 8 Then
If WordDoc.ContentControls(i).Checked Then
DocSheet.Cells(i + 1, 2).Value = "True"
Else
DocSheet.Cells(i + 1, 2).Value = "True"
End If
Else
DocSheet.Cells(i + 1, 2).Value = WordDoc.ContentControls(i).Range.Text.Trim
End If
Next i


Added a .Trim to Range.Text

Now I get Invalid Qualifier error. How do I make this code work?

[gmaxey]

You can start by removing "Trim" after .Text. That is what caused the invalid qualifier. Do you want to "Trim" the content of the CC?

Trim(WordDoc.ContentControls(i).Range.Text)

Change the second "True" to "False" as Graham correctly points out.