Exporting from Word Content Control Boxes to Excel

[cassienikole]

Hi, I have 6 word documents with a total 399 Check Content Control boxes, 399 Date Picker Content Control boxes along with a Rich Text Content Control box at the top requiring a name stored on a SharePoint site. These will be opened by 1000's of people, renamed and saved back to the same folder on the SharePoint site. Each person will be using these documents to check securities to different systems, if there is no access they will select ‘No’ then enter the date.

I also have an excel sheet with a column titled for each of those 399 boxes. Now, I am trying to find a way to easily export what is marked as a 'No' along with the persons name and date to that Excel sheet. The ultimate goal is that once the person gains access the check mark will be removed from the content box therefore removing the information from the corresponding column on the excel sheet. All in all I am wanting them to be self-sustaining and I just have to look at the Excel sheet.

Basically, I've seen it done but I have NO idea how to do it! Any help or thoughts you could off would be very appreciated. I'm sorry if this is already in a thread somewhere, I've been reading through them for about 3 hours and haven't come across my situation yet so I thought it was best to just ask.

Thank you for reading.
Cassie

 

[Macropod]

Try something along the lines of:

Sub GetFormData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document, CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String, WkSht As Worksheet, r As Long, c As Long
strFolder = GetFolder: If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
With WkSht
  r = .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
  .Range("A2:A" & r).EntireRow.Delete
End With
r = 2
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  r = r + 1
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    c = 0
    For Each CCtrl In .ContentControls
      With CCtrl
        Select Case .Type
          Case wdContentControlCheckBox
            c = c + 1
            WkSht.Cells(r, c) = .Checked
          Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
            c = c + 1
            If IsNumeric(.Range.Text) Then
              If Len(.Range.Text) > 15 Then
                WkSht.Cells(r, c) = "'" & .Range.Text
              Else
                WkSht.Cells(r, c) = .Range.Text
              End If
            Else
              WkSht.Cells(r, c) = .Range.Text
            End If
          Case Else
        End Select
      End With
    Next
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

As coded, the macro clears and overwrites rows 2 and following in the worksheet.

If you want to record the document's name as part of the data, change:
c = 0
to:
c = 1: WkSht.Cells(r, c) = strFile

You also refer to capturing 'the persons name and date'. It's not apparent from your post, though, whether those details are stored in content controls in the documents. If they are, they will be output; otherwise, you'll need to provide more details.