Paste content control text from word doc into excel cells

[jmdeland]

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]

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