Issues when content controls are deleted in word forms

[harry.ayre]

Hi

I have been using the forums on this site for some time and have found them incredibly useful. Thank you!

I have a large number of word forms with content controls in paragraphs of text as well as tables. I also have an excel sheet which pulls the values in the word form fields, in order from left to right, in to the excel sheet. I have put titles in the excel sheet so that the values that are pulled in to the excel sheet fall under the respective titles of the values that they represent in the word form.

Here is a copy of my code:
Sub GetFormData()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
For Each CCtrl In .ContentControls
j = j + 1
WkSht.Cells(i, j) = CCtrl.Range.Text
Next
End With
wdDoc.Close SaveChanges:=False
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


Public Sub ClearSheet()


'Clear Sheet Data'


Rows("6:2000").Select
Selection.ClearContents
End Sub


The problem that I'm having is that users of the forms cannot delete any of the form fields in the word forms. If this occurs, the excel does not account for the deleted form field. Is there any way that I can code something which will leave a blank cell in excel where the form field was deleted? Currently, when a form field is deleted in the word document, the values in the excel sheet don't match up with the titles correctly.

Any help would be very appreciated.

Thanks!

[Doug Robbins]

I guess that you meant to say that the "the users of the forms CAN delete any of the ContentControls". You can stop them from doing that by checking the box for ContentControl cannot be deleted, or, if you want to allow them to delete ContentControls, you could use the .Tag of the ContentControl (if they have been uniquely assigned) to identify each ContentControl and thus determine into which column its contents should be inserted.

[harry.ayre]

Thanks for the quick reply Doug. Yes, I would like for users to be able to delete the content controls.

In regards to your comment:
".Tag of the ContentControl (if they have been uniquely assigned) to identify each ContentControl and thus determine into which column its contents should be inserted."

This sounds like a good solution. How would I go about implementing it. Given that there are around 400 fields in the word form, is there a way to uniquely assign the content controls automatically?

Thanks

[Doug Robbins]

You could use code such as the following to assign a sequential number as the tag for each ContentControl


Dim cc As ContentControl
Dim i As Long
i = 1
For Each cc In ActiveDocument.ContentControls
cc.Tag = i
i = i + 1
Next

Then you could probably make use of the tag number with .Offset(rownum,colnum) to determine the cell into which the contents of each tag are to be inserted.

[harry.ayre]

Thanks so much for your help Doug!

Would you be able to help by giving me some advice on how to edit my excel VBA to extract these tagged content controls in to specific cells? For each word file, I really need to be able to have each content control assigned to an excel cell so that tag one is in A6, tag 2 is in A7, tag 3 is in A8 and so on and so forth. And for each new word file in the folder to start on the next row in excel.

Will this be possible?

Thank you!

[Doug Robbins]

This should do it:


Sub GetFormData()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
For Each CCtrl In .ContentControls
WkSht.Cells(i, CCtrl.Tag + 5) = CCtrl.Range.Text
Next
End With
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

[harry.ayre]

Thanks for the help Doug, I appreciate it! I think this nearly works but there is an issue that I can't figure out. When I run the macro, the debugger will pick out the line of code that I have highlighted here in red as an issue. In addition to this, the macro appears to have difficulty accessing the word docs. They are macro-enabled word docs and are unprotected. For some reason, the macro appears to face the same problem as if I had tried to run it with the word doc already open.

Any thoughts?

Thanks!


This should do it:


Sub GetFormData()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim CCtrl As Word.ContentControl
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
For Each CCtrl In .ContentControls
WkSht.Cells(i, CCtrl.Tag + 5) = CCtrl.Range.Text
Next
End With
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

[Doug Robbins]

Sorry, I did not pay attention to the first part of your code. You need to use GetObject or CreateObject to set up the Word Application.


Sub GetFormData()
Application.ScreenUpdating = False
Dim wdApp As Object
Dim wdDoc As Object
Dim CCtrl As Object
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Boolstartapp = True
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
For Each CCtrl In .ContentControls
WkSht.Cells(i, CCtrl.Tag + 5) = CCtrl.Range.Text
Next
End With
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub