PDA

View Full Version : Paste content control text from word doc into excel cells



jmdeland
03-14-2013, 03:34 PM
I have found some great information on here so far but it seems my lack of coding knowledge has got me stuck. Here is what I am trying to do:

(Office 2010) I have a word document that has several plain text content control boxes. The user opens them via template and it automatically saves to a network drive.

I'm trying to write a macro that will allow an admin from excel to select the saved word doc and automatically populate some cells with only 4 (out of 8) of the cc fields with the text that has been entered in that field.

I have found several variations of this that come close to what I need but I can't seem to tie them together properly.

From this site:



Sub GrabUsage()
Dim FName As String, FD As FileDialog
Dim WApp As Object, WDoc As Object, WDR As Object
Dim ExR As Range
Set ExR = Selection ' current location in Excel Sheet
'let's select the WORD doc
Set FD = Application.FileDialog(msoFileDialogOpen)
FD.Show
If FD.SelectedItems.Count <> 0 Then
FName = FD.SelectedItems(1)
Else
Exit Sub
End If
' open Word application and load doc
Set WApp = CreateObject("Word.Application")
' WApp.Visible = True
Set WDoc = WApp.Documents.Open(FName)
' go home and search
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "Minimum Stock"

' move cursor from find to final data item
WApp.Selection.MoveDown Unit:=5, Count:=1
WApp.Selection.MoveRight Unit:=2, Count:=2
' the miracle happens here
WApp.Selection.MoveRight Unit:=2, Count:=1, Extend:=1
' grab and put into excel
Set WDR = WApp.Selection
ExR(1, 1) = WDR ' place at Excel cursor
'repeat
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "Period of Report:"
WApp.Selection.MoveRight Unit:=2, Count:=8
WApp.Selection.MoveRight Unit:=2, Count:=3, Extend:=1
Set WDR = WApp.Selection
ExR(1, 2) = WDR ' place in cell right of Excel cursor
WDoc.Close
WApp.Quit
End Sub


This got me very close, obviously other than this will only grab text and not content control text. More searching got me this:


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 = "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


This does almost everything else I want except I do not want it to do all the documents at once, I want to do them individually - and it does ALL the content controls and I only need a few preferably by tag.


Sub ScratchMacro()
'CCs can be referenced in the following ways:
' 1. By their position (Index number) in the document.
' 2. By Title and item number
' 3. By Tag ane item number
' 4. By a unique ID defined when the CC is created.
MsgBox ActiveDocument.ContentControls(2).Range.Text
'Since Title and Tag are not unique you need to use Item as well.
MsgBox ActiveDocument.SelectContentControlsByTitle("SiteName").Item(1).Range.Text
MsgBox ActiveDocument.SelectContentControlsByTag("Technician").Item(1).Range.Text
'Select the CC and get its ID
' Debug.Print Selection.Range.ContentControls(1).ID
'Reference by ID.
' MsgBox ActiveDocument.ContentControls("420146660").Range.Text
End Sub

Here I was able to alter it to put the text i wanted into a msgbox (in word) but I need it pasted into a cell.

If anyone had time to muddle through this with me or if someone could point me to an example that would be great!!

jmdeland
03-14-2013, 03:40 PM
For clarification; in the excel sheet, I'd like to place my cursor on B2 and have it populate B2, C2, D2, E2 with the particular content control fields from the opened word document.

Then I could place the cursor on B3, run the macro which prompts me to open a file, select a different word doc and have it populate B3, C3, D3, E3 with the corresponding content control text from that document.

That is the final goal :)