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.Laser Registration Form_test.docx
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!