VBA import certain content control forms from word into excel.

[DJKemp94]

Hi Guys,

I hope you're doing well.
I'm fairly new to visual basic, and I've been trying to set up a form that can be completed in Word, and I want to be able to export some of the values in the fields over to Excel, but not all.

I've attached a small example of the form.28272

So far, I've mostly 'borrowed' code found on the internet and adapted it slightly, so currently it will import all the answers to all of the word documents in a folder, and it will populate the spreadsheet from the top down.

So, looking at the form I've uploaded, for example, how would I modify this to only import, say Laser Model and Laser Power, and then ignore the rest of the fields?
Currently, I've just been tempted to import it all, and then post-process it with another script to delete the unwanted fields, but this is quite cumbersome.

Current code is below.


Sub GetFormData()
'Note: this code requires a reference to the Word object model
'To do this, go to Tools|References in the VBE, then scroll down to the Microsoft Word entry and check it.
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, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
Dim Target As Integer
Target = Sheet4.Range("F3").Value
i = Sheet5.Range("Word_Start").Offset(Target, 0).Row
strFile = Dir(strFolder & "\*.docx", 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
With CCtrl
Select Case .Type
Case Is = wdContentControlCheckBox
j = j + 1
WkSht.Cells(i, j).Value = .Checked
Case wdContentControlDate, wdContentControlDropdownList, wdContentControlRichText, wdContentControlText
j = j + 1
WkSht.Cells(i, j).Value = .Range.Text
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

Any help at all would be appreciated, so thank you for your time!

[macropod]

You don't need the For Each loop. All you need do is specify the content controls and the Excel cells to which their content should be exported. Hence:

With wdDoc
WkSht.Cells(i, 1).Value = .ContentControls(1).Range.Text
WkSht.Cells(i, 2).Value = .ContentControls(5).Range.Text & .ContentControls(6).Range.Text
.Close SaveChanges:=False
End With

[DJKemp94]

You don't need the For Each loop. All you need do is specify the content controls and the Excel cells to which their content should be exported. Hence:

With wdDoc
WkSht.Cells(i, 1).Value = .ContentControls(1).Range.Text
WkSht.Cells(i, 2).Value = .ContentControls(5).Range.Text & .ContentControls(6).Range.Text
.Close SaveChanges:=False
End With

Thanks so much for your help.
That's incredibly helpful. I've just got it into the code and it's working, so now I can edit that to get all the fields I want in.
Sorry if it seemed basic. I've done a bit of programming in Python, but VBA seems a little more tricky to get my head around!