PDA

View Full Version : Evaluate content control title and move to correct column



dmills21
02-11-2014, 04:14 PM
Hello,

I have this setup and it is exporting the data from word to excel in a single row. I would like the VB to evaluate the content control title and put the data in the correct column. For example if I have a content control titled "1" I want the value to go in column A, if titled "2" the value should go in b. This would create a table structure as it found each value. So each new value of the specific title would be a new row in the excel sheet. Thanks for the help!

p45cal
02-12-2014, 10:18 AM
I really think we need to see some sample data. It would help if you could attach (or provide a link to) a workbook showing where you've got so far (the code may just need a tweak or two) along with a sample Word document. That way we should be able to provide a meaningful response rather than just guesses which would very likely be awry.

dmills21
02-12-2014, 12:24 PM
Here are some more details.

In the word document attached, I have 6 rich text content controls with three unique types. The unique types as defined by the tag are "Test Value 1", "Test Value 2", "Test Value 3". The following values are in each tag in order of how they appear in the document:




Tag Name
Value


Test Value 1
Test Value


Test Value 1
Test value 2


Test Value 3
Test Value 3


Test Value 1
Test Value b


Test Value 2
Test Value 2b


Test Value 3
Test Value 3b



I would like the VB to process the file(s) and say all Test Value 1 content controls go in column A in the spreadsheet, all Test Value 2 content controls go in column B, and all Test Value 3 content controls go in column C.

So the table would look like:



Column A
Column B
Column C


Test Value
Test Value 2
Test Value 3


Test Value b
Test Value 2 b
Test Value 3 b



Instead it looks like



Column A
Column B
Column C
Column D
Column E
Column F


Test Value
Test Value 2
Test Value 3
Test Value b
Test Value 2 b
Test Value 3 b




Here is the vb:

Option Explicit
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:\Users\dmills.BRGL\Desktop\gapunprocessed"
outPath = "C:\Users\dmills.BRGL\Desktop\gapprocessed"
'inPath = ThisWorkbook.Path & "\in\"
'outPath = ThisWorkbook.Path & "\out\"
vColumn = 1
vLastRow = ActiveSheet.UsedRange.Rows.Count + 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 Or vField.Type = wdContentControlRichText Then '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

dmills21
02-12-2014, 12:33 PM
Here is the xlsm

p45cal
02-12-2014, 04:57 PM
The below code should get you going a little way.
Since you want the column it goes in to be determined by the tag then the vlastrow will need to change as you go through a single file because there are several tags which are the same within a file.
Your sample word document had equal numbers of each tag and in the right order but.. if there is a rich text control with no text, or a missing tag then the data retrieved will probably end up in the wrong row. There is a comment about this in the code.
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:\Users\dmills.BRGL\Desktop\gapunprocessed"
'outPath = "C:\Users\dmills.BRGL\Desktop\gapprocessed"
inPath = ThisWorkbook.Path & "\in\"
outPath = ThisWorkbook.Path & "\out\"

vColumn = 1
'vLastRow = ActiveSheet.UsedRange.Rows.Count + 1 'determined later.

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 'simplified in the line below:
For Each vField In 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 Or vField.Type = wdContentControlRichText Then 'Or vField.Type = wdContentControlComboBox Or vField.Type = wdContentControlDropdownList Or vField.Type = wdContentControlText Then
'MsgBox vField.Tag
Select Case vField.Tag
Case "Test Value 1"
vColumn = 1
Case "Test Value 2"
vColumn = 2
Case "Test Value 3"
vColumn = 3
' 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
vLastRow = ActiveSheet.Cells(Rows.Count, vColumn).End(xlUp).Row + 1 'this finds the lastrow in the relevant column, but it may not always give you what you want..
ActiveSheet.Cells(vLastRow, vColumn).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

dmills21
02-13-2014, 03:14 PM
Thank you so much! This is exactly what I needed. One more question, is there a way to add the word file name to column 4 and a timestamp to column 5?

p45cal
02-15-2014, 09:48 PM
Thank you so much! This is exactly what I needed. One more question, is there a way to add the word file name to column 4 and a timestamp to column 5?
1. The full name including path or just the filename? If the former, the path where the file has been moved from, or moved to?
2. Do you want to include date information with the timestamp?

dmills21
02-18-2014, 09:34 AM
Hi p45cal,

1. Just the filename
2. Yes, the date and a time stamp of when the data was imported to the spreadsheet

Thanks for the help!

p45cal
02-18-2014, 11:20 AM
Where there was
ActiveSheet.Cells(vLastRow, vColumn).Value = vValueadd two lines to leave:
ActiveSheet.Cells(vLastRow, vColumn).Value = vValue
ActiveSheet.Cells(vLastRow, 4).Value = fsFile.Name
ActiveSheet.Cells(vLastRow, 5).Value = CDate(Date + Time)

dmills21
02-18-2014, 03:43 PM
thanks again! this really helps me understand the structure for future uses.