Exporting data from content control fields in word to excel 2010

[sandervd]

Hi,
I've been searching all kinds of fora for this problem and although I find information on how to do this with (legacy) Form Fields, my problem involves Content Control fields and I can't seem to fix this.
Basically I have Sales Reports that are being filled out on a weekly basis by all Sales Reps. These contains all kinds of different Content Control fields (Drop down, rich text, dates etc...), and the data in there should be copied to an excel sheet. Meaning: copying the contents of the fields from all the different reports into 1 excel report.
Below is a Macro I found which works for legacy forms (FieldForm) (pre-2007) but I cannot seem to make it work for 2010. I pinned down the problem to being just a wording problem in MS, but then again, it might be a little more complicated

Many thanks for your help,

Dim vField As FormFields
Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim vColumn As Integer
Dim vLastRow As Integer
Dim x As Integer
Sub AddFormFields()
vLastRow = ActiveSheet.UsedRange.Rows.Count + 1
vColumn = 1
Set fso = New Scripting.FileSystemObject
Set fsDir = fso.GetFolder _
("Q:\Sales Reports\Unprocessed")
Set wdApp = New Word.Application
wdApp.Visible = True
For Each fsFile In fsDir.Files
wdApp.Documents.Open (fsFile)
Set myDoc = wdApp.ActiveDocument
For Each vField In wdApp.Documents(myDoc).FormFields
vField.Select
vValue = vField.Result
Workbooks("Sales.xlsm").Activate
Cells(vLastRow, vColumn).Select
If vField.Type = 71 Then
Select Case vField.Name
Case "Check1"
vColumn = vColumn - 1
If vField.Result = "1" Then
ActiveCell.Value = "YES"
End If
Case "Check2"
If vField.Result = "1" Then
ActiveCell.Value = "NO"
End If
End Select
Else
ActiveCell.Value = vValue
End If
vColumn = vColumn + 1
Next
vColumn = 1
vLastRow = vLastRow + 1
vFileName = wdApp.ActiveDocument.Name
wdApp.ActiveDocument.Close
Name fsFile As _
"Q:\Sales Reports\Processed\" & vFileName
Next
wdApp.Quit


End Sub

[Kenneth Hobs]

Welcome to the forum!

This is similar to: http://www.excelforum.com/excel-programming/799070-import-text-fields-from-word.html

In that thread, I showed how to modify the If line that limits formfields by Type. Instead, just remove that If and End If and add your Case's as needed.

[sandervd]

Hi Kenneth,
Thanks for the help. This is indeed pointing in the right direction, but I'm still a bit stuck. Since it concerns the NEW Content Control fields, and no longer the legacy Field Forms I need to use the other enumeration: ([add www] better [remove spacing] solutions.com/word/WRV283/LY025951611.htm)
However I don't find what to replace vField with (since I understand this points towards the Field Forms?)

PS: can't post links yet apparently, so hence the [add www] and [remove spacing] will be needed :) Although probably you wouldn't even need the link...

[Kenneth Hobs]

I don't know that I have used those controls. http://bettersolutions.com/word/WRV283/LY025951611.htm

The 5 post limit gives the moderators time to cull spam. Since you have not met the 5 post requirement yet, you can reply a few times and explain things and then post the excel and word files or post to a free shared site and mark up the link as you did.

The more simple the example, the easier it is to help. It should be robust enough though to include the various controls that might occur if they are not in a standard collection like formfields.

[sandervd]

Hi,

Okay, so I'll just make a couple of posts, here is already some information to explain the content controls:

Apparently in MS 2007 someone decided to update the FormFields and invented the Content Control fields. They offer more features (richtext, date picker, unlimited dropdown lists etc.) but they are a whole new league. Meaning the coding for the old FormFields doesn't work on these new ones anymore.

[sandervd]

Oh yeah,
And in my document I have text fields, drop down boxes, combo boxes (drop down but you can just type in another option if you want to) and date pickers. It's a quite big document with many fields in there (over 200 actually), so gathering information from it through copy-pasting into an excel spreadsheet is a real mess. That's why I'm looking for a way to automate this process. I noticed macros exist for FormFields, so I wondered whether it was also possible for Content Control. I think the above posted macro (or yours on excelforum for that matter) is actually a good start, just need to change the dim vField=FormFields to sth else, probably and then implement that all the way through (thinking about your previous comment on adding 'OR's to the 'if' to include all different options). Just wondering about what it needs to be changed into...?

[sandervd]

In my next post I'll post a quick example of a shorter version of the document to test all options. I'll also put in some legacy FormFields to show that it does work for those fields, but not for the ContentControl fields. In my real document I don't have these old FormFields anymore...

[sandervd]

Here I attached an example.

I added all the possible fields, as you can see some are them are in a table (as in the real doc), in case that would pose problems? Up till now the table doesn't contain too many fields yet (mostly dates and drop down boxes) but I can add a field to every part of it to extract all data at once.

Many thanks for any help you might give me :)

Cheers

[Kenneth Hobs]

One more thing, please explain how to add one of those controls in Word manually. I might know but I want to make sure that I do as you did. Recording the macro to do it gives us our beginning point. Opps, I just gave away the farm...

[sandervd]

you add them from the developer tab (sure you know how to get this as a VBA tutor ;) under controls...

I just added all these types to the doc while recording, here is the macro:

Sub Macro1()
'
' Macro1 Macro
' adding controls
'
'
Selection.Range.ContentControls.Add (wdContentControlDate)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.Range.ContentControls.Add (wdContentControlRichText)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.Range.ContentControls.Add (wdContentControlComboBox)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.Range.ContentControls.Add (wdContentControlDropdownList)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
End Sub

[sandervd]

(of course after adding I pressed arrow right and enter to get to a new line, so disregard those when looking at the macro ;))

[Kenneth Hobs]

You may want to check the checkbox case. You might want to check for True or False rather than "1" or "0" to set the Yes or No for cell.Value.

Option Explicit

' http://www.vbaexpress.com/forum/showthread.php?t=39654
Sub AddContentControlValues()
' Add Tools > References: Microsoft Word and Microsoft Scripting Runtime
Dim vField As ContentControl
Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim vColumn As Integer
Dim vLastRow As Integer
Dim i As Integer
Dim vValue As Variant
Dim vFileName As String
Dim cell As Excel.Range
Dim inPath As String, outPath As String

inPath = "C:\Documents and Settings\richard.b.rivera\Desktop\dart UnProcessed\"
outPath = "C:\Documents and Settings\richard.b.rivera\Desktop\dart Processed\"
inPath = ThisWorkbook.Path & "\in\"
outPath = ThisWorkbook.Path & "\out\"


vLastRow = ActiveSheet.UsedRange.Rows.Count + 1
vColumn = 1

Set fso = New Scripting.FileSystemObject
Set fsDir = fso.GetFolder(inPath)

Set wdApp = New Word.Application
wdApp.Visible = True

For Each fsFile In fsDir.Files
wdApp.Documents.Open (fsFile)
Set myDoc = wdApp.ActiveDocument
For Each vField In wdApp.Documents(myDoc).ContentControls
vValue = vField.Range.Text
''''''' Workbooks("DARTS.xlsm").Activate 'Needed? Not needed if macro ran from it.
Set cell = Cells(vLastRow, vColumn)

If vField.Type = wdContentControlCheckBox Then
Select Case True
Case vField.Checked = True And vField.Checked
vColumn = vColumn - 1
Debug.Print vField.Range.Text
If vField.Range.Text = "1" Then cell.Value = "YES"
Case vField.Range.Text = True And vField.Checked = False
If vField.Range.Text = "1" Then cell.Value = "NO"
End Select
Else
cell.Value = vValue
End If
vColumn = vColumn + 1

Next vField

vColumn = 1
vLastRow = vLastRow + 1
vFileName = wdApp.ActiveDocument.Name
wdApp.ActiveDocument.Close
Name fsFile As outPath & vFileName
Next fsFile

wdApp.Quit
End Sub

[sandervd]

Thanks Kenneth,
I've tried modifying it to extract values from the other types (date picker, combo box, drop down etc. ) However, when I use your check box code it gives me error 6290 (only available for check box contents). When I replace it with the code below (as I found for text fields etc. in Field Forms) I get a compile error (method or data member not found)...?


If vField.Type = wdContentControlCheckBox Or vField.Type = wdContentControlRichText Or vField.Type = wdContentControlComboBox Or vField.Type = wdContentControlDropdownList Or vField.Type = wdContentControlText Then
Select Case vField.Name
Case "Check1"
vColumn = vColumn - 1
If vField.Result = "1" Then cell.Value = "YES"
Case "Check2"
If vField.Result = "1" Then cell.Value = "NO"
End Select
Else
cell.Value = vValue
End If
vColumn = vColumn + 1

[sandervd]

Okay, I got it to extract my dates (see code below). However, the rest is not being extracted... Any ideas what's wrong with it?

If vField.Type = wdContentControlCheckBox Or vField.Type = wdContentControlRichText Or vField.Type = wdContentControlComboBox Or vField.Type = wdContentControlDropdownList Or vField.Type = wdContentControlText Then
Select Case vField.Range.Text
Case "Check1"
vColumn = vColumn - 1
If vField.Range.Text = "1" Then cell.Value = "YES"
Case "Check2"
If vField.Range.Text = "1" Then cell.Value = "NO"
End Select

[sandervd]

okay, (spamming my own thread :) I noticed that actually the only field it picked was the one I forgot to specify (CheckBox instead of Date) so I commented out all the others and now it works? Not quite sure why that is, but it works so that's good. If anyone could explain why it didn't work when specified but did when not specified that would help me a lot in better understanding VBA. I'll mark this thread solved tomorrow after I checked it really took ALL the fields in my final docs.
Thanks for the help!
Cheers

Option Explicit

' http://www.vbaexpress.com/forum/showthread.php?t=39654
Sub AddContentControlValues()
' Add Tools > References: Microsoft Word and Microsoft Scripting Runtime
Dim vField As ContentControl
Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim vColumn As Integer
Dim vLastRow As Integer
Dim i As Integer
Dim vValue As Variant
Dim vFileName As String
Dim cell As Excel.Range
Dim inPath As String, outPath As String

inPath = "Q:\Sales Reports\Unprocessed\"
outPath = "Q:\Sales Reports\Processed\"
'inPath = ThisWorkbook.Path & "\in\"
'outPath = ThisWorkbook.Path & "\out\"


vLastRow = ActiveSheet.UsedRange.Rows.Count + 1
vColumn = 1

Set fso = New Scripting.FileSystemObject
Set fsDir = fso.GetFolder(inPath)

Set wdApp = New Word.Application
wdApp.Visible = True

For Each fsFile In fsDir.Files
wdApp.Documents.Open (fsFile)
Set myDoc = wdApp.ActiveDocument
For Each vField In wdApp.Documents(myDoc).ContentControls
vValue = vField.Range.Text
''''''' Workbooks("DARTS.xlsm").Activate 'Needed? Not needed if macro ran from it.
Set cell = Cells(vLastRow, vColumn)

If vField.Type = wdContentControlCheckBox Then 'Or vField.Type = wdContentControlRichText Or vField.Type = wdContentControlComboBox Or vField.Type = wdContentControlDropdownList Or vField.Type = wdContentControlText Then
Select Case vField.Range.Text
Case "Check1"
vColumn = vColumn - 1
If vField.Range.Text = "1" Then cell.Value = "YES"
Case "Check2"
If vField.Range.Text = "1" Then cell.Value = "NO"
End Select
'Select Case True
'Case vField.Checked = True And vField.Checked
'vColumn = vColumn - 1
'Debug.Print vField.Range.Text
'If vField.Range.Text = "1" Then cell.Value = "YES"
'Case vField.Range.Text = True And vField.Checked = False
'If vField.Range.Text = "1" Then cell.Value = "NO"
'End Select
Else
cell.Value = vValue
End If
vColumn = vColumn + 1


Next vField

vColumn = 1
vLastRow = vLastRow + 1
vFileName = wdApp.ActiveDocument.Name
wdApp.ActiveDocument.Close
Name fsFile As outPath & vFileName
Next fsFile

wdApp.Quit
End Sub

[Kenneth Hobs]

It worked for all of the fields for me. I did not check the checkedbox case though. You can just add that one control in a file and step through it to see what the Select Case was doing. Rather than doing the If, one could just set the vValue in the Select Case. Here is where it put all the values in except for the checkedbox as I explained.

cell.Value = vValue

This might still need a tweak for the checkedbox Select Case but might be a bit more clear for you.

Option Explicit

' http://www.vbaexpress.com/forum/showthread.php?t=39654
Sub AddContentControlValues()
' Add Tools > References: Microsoft Word and Microsoft Scripting Runtime
Dim vField As ContentControl
Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim vColumn As Integer
Dim vLastRow As Integer
Dim i As Integer
Dim vValue As Variant
Dim vFileName As String
Dim cell As Excel.Range
Dim inPath As String, outPath As String

inPath = "Q:\Sales Reports\Unprocessed\"
outPath = "Q:\Sales Reports\Processed\"
'inPath = ThisWorkbook.Path & "\in\"
'outPath = ThisWorkbook.Path & "\out\"


vLastRow = ActiveSheet.UsedRange.Rows.Count + 1
vColumn = 1

Set fso = New Scripting.FileSystemObject
Set fsDir = fso.GetFolder(inPath)

Set wdApp = New Word.Application
wdApp.Visible = True

For Each fsFile In fsDir.Files
wdApp.Documents.Open (fsFile)
Set myDoc = wdApp.ActiveDocument
For Each vField In wdApp.Documents(myDoc).ContentControls
vValue = vField.Range.Text
''''''' Workbooks("DARTS.xlsm").Activate 'Needed? Not needed if macro ran from it.
Set cell = Cells(vLastRow, vColumn)

If vField.Type = wdContentControlCheckBox Then 'Or vField.Type = wdContentControlRichText Or vField.Type = wdContentControlComboBox Or vField.Type = wdContentControlDropdownList Or vField.Type = wdContentControlText Then
Select Case vField.Range.Text
Case "Check1"
vColumn = vColumn - 1
If vField.Range.Text = "1" Then vValue = "YES"
Case "Check2"
If vField.Range.Text = "1" Then vValue = "NO"
End Select
End If
cell.Value = vValue

vColumn = vColumn + 1
Next vField

vColumn = 1
vLastRow = vLastRow + 1
vFileName = wdApp.ActiveDocument.Name
wdApp.ActiveDocument.Close
Name fsFile As outPath & vFileName
Next fsFile

wdApp.Quit
End Sub

[Kenneth Hobs]

I went ahead and added two checkboxes to test it. It worked fine. You need to evaluate the Case for those though. It makes no sense to me to offset the column number by one for one case. In this type of control, if you want to use a name, set the Tag property as I did or use the Title property and change the code accordingly. I named the two checkbox content controls with Tag property values of: TextBox1 and TextBox2. I also added an Else to the If in the Case statement.

Option Explicit


' http://www.vbaexpress.com/forum/showthread.php?t=39654
Sub AddContentControlValues()
' Add Tools > References: Microsoft Word and Microsoft Scripting Runtime
Dim vField As ContentControl
Dim fso As Scripting.FileSystemObject
Dim fsDir As Scripting.Folder
Dim fsFile As Scripting.File
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim vColumn As Integer
Dim vLastRow As Integer
Dim i As Integer
Dim vValue As Variant
Dim vFileName As String
Dim cell As Excel.Range
Dim inPath As String, outPath As String

'inPath = "Q:\Sales Reports\Unprocessed\"
'outPath = "Q:\Sales Reports\Processed\"
inPath = ThisWorkbook.Path & "\in\"
outPath = ThisWorkbook.Path & "\out\"


vLastRow = ActiveSheet.UsedRange.Rows.Count + 1
vColumn = 1

Set fso = New Scripting.FileSystemObject
Set fsDir = fso.GetFolder(inPath)

Set wdApp = New Word.Application
wdApp.Visible = True

For Each fsFile In fsDir.Files
wdApp.Documents.Open (fsFile)
Set myDoc = wdApp.ActiveDocument
For Each vField In wdApp.Documents(myDoc).ContentControls
vValue = vField.Range.Text
''''''' Workbooks("DARTS.xlsm").Activate 'Needed? Not needed if macro ran from it.
Set cell = Cells(vLastRow, vColumn)

If vField.Type = wdContentControlCheckBox Then 'Or vField.Type = wdContentControlRichText Or vField.Type = wdContentControlComboBox Or vField.Type = wdContentControlDropdownList Or vField.Type = wdContentControlText Then
Select Case vField.Tag
Case "CheckBox1"
vColumn = vColumn
If vField.Checked = True Then
vValue = "YES"
Else
vValue = "Not Checked"
End If
Case "CheckBox2"
If vField.Checked = True Then
vValue = "NO"
Else
vValue = "Not Checked"
End If
End Select
End If
cell.Value = vValue

vColumn = vColumn + 1
Next vField

vColumn = 1
vLastRow = vLastRow + 1
vFileName = wdApp.ActiveDocument.Name
wdApp.ActiveDocument.Close
Name fsFile As outPath & vFileName
Next fsFile

wdApp.Quit
End Sub

[sandervd]

Hi Kenneth,
Thanks a bunch! I didn't have checkboxes in my file (yet) because they tend not to work on other people's computers... (just made dropdown lists for them..) But still nice to know how to do it in a macro :) I'll mark the thread solved and will happily use this macro to save me lots of time. Hope others will find it useful too!
Thanks again!
Sander

[sandervd]

Okay, someone else apparently has to mark this SOLVED, admin or Kenneth, please do so?
Cheers!