Pull data from Word to Excel help

[beila00]

Hi there, I watched a video on youtube to get data from Word forms in Excel using vba. My word document has formfields that contain the data I want, and I only want two of the fields, not all of them. I have tried to play with the code in the video but am stuck and was hoping someone can help. Here is what I originally started with: The code I wrote, in Excel, works but is currently only pulling from one file. I would like for it to pull every file that I have saved in a particular folder.


Sub wrd11()
Dim wrd As Word.Application
Set wrd = CreateObject("Word.Application")
With wrd.Documents.Open "C:\Users\dculnane\Documents\Performance Evaluations\Working forms\PE Manager Form.docx".Visible = True
End With
Range("a2").Value = wrd.ActiveDocument.FormFields("Text8").Result
Range("b2").Value = wrd.ActiveDocument.FormFields("Text20").Resultwrd.Quit
End Sub

I can’t figure out where to change my code. this works, but only pulls from one file. I need to use formfields and not content controls.Here is what I have so far:


Sub getWordFormData()
Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim FFtl As Word.FormFields
Dim myFolder As String, strFile As StringDim myWkSht As Worksheet, i As Long, j As Long
myFolder = "C:\temp\test"
Application.ScreenUpdating = False
If myFolder = "" Then
Exit Sub
Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear
Range("A1") = "Employee Name"
Range("A1").Font.Bold = True
Range("B1") = "Total"
Range("B1").Font.Bold = True
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "\*.docx", vbNormal)
While strFile <> ""i = i + 1
Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With myDocj = 0
For Each FFtl In .FormFieldsj = j + 1
myWkSht.Cells(i, j) = FFtl.Range.Text
Next
myWkSht.Columns.AutoFit
End With
myDoc.Close SaveChanges:=Falsestr
File = Dir()WendwdApp.Quit
Set myDoc = Nothing:
Set wdApp = Nothing:
Set myWkSht = Nothing
Application.ScreenUpdating = True
End Sub

[snb]

sub M_snb()
sn=filter(split(createobject("wscript.shell").exec("cmd /c dir ""C:\Users\dculnane\Documents\Performance Evaluations\Working forms\*.docx"" /b/s").stdout.readall,vbcrlf),".")

for each it in sn
with getobject(it)
activesheet.cells(rows.count,1).end(xlup).offset(1).resize(,2)=array(.FormF ields("Text8").Result,.FormFields("Text20").Result)
.close 0
end with
next
End Sub

[GTO]

Greetings Beila and welcome to VBA Express :hi:,

I read through the code you tried. One thing I noticed is that you declared FFtl As Word.FormFields. It would need to be a FormField (the object rather than the collection).

Anyways, as you mention only wanting two of the formfield(s) returned, here is what I came up with. It appears to be a bit quicker (cursory testing only) and handles the error if the field doesn't exist.



Option Explicit
'
'Tab Name | TypeName | .Type
'---------------------------------------
'Sheet1 | Worksheet | -4167
'Sheet2 | Worksheet | -4167
'Dialog1 | DialogSheet | TYPE = err
'Macro1 | Worksheet | 3
'Macro2 intl | Worksheet | 4
'Chart1 | Chart | 3
'Sheet3 | Worksheet | -4167
'
Sub TestLoopThruFolder()
Dim WD As Object ' Word.Application
Dim DOC As Object ' Word.Document
Dim FFIELD As Object ' Word.FormField
Dim WKS As Worksheet
Dim lRow As Long
Dim strPath As String
Dim strFileName As String
Dim bolKillWord As Boolean
'
'Dim a: a = Timer
'
'// Alter path to suit. I just created several word files (3 each, .doc, docx, docm) and //
'// plunked them into a folder. //
strPath = ThisWorkbook.Path & "\"
strFileName = Dir(strPath & "*.docx", vbNormal)
'
'// Ensure we found at least one file or exit...//
If strFileName = vbNullString Then
MsgBox "No files found; exiting...", vbOKOnly Or vbInformation, "My Title"
Exit Sub
Else
'// Ensure the ActiveSheet is a Worksheet or bail...//
If TypeName(ActiveSheet) = "Worksheet" Then
If ActiveSheet.Type = xlWorksheet Then
Set WKS = ActiveSheet
With WKS
.Cells.Clear
Application.ScreenUpdating = False
.Range("A1:B1").Value = Array("Employee Name", "Total")
.Range("A1:B1").Font.Bold = True
End With
Else
GoTo BailOut
End If
Else
GoTo BailOut
End If
End If
'
'// If we made it here, now get or set a reference to WORD. If we needed to CreateObject, //
'// we'll kill the instance of Word. This way we don't kill WORD if the user already had //
'// a copy running. //
On Error Resume Next
Set WD = GetObject(, "Word.Application")
If CBool(Err) Then bolKillWord = True
On Error GoTo 0
'
If bolKillWord Then
Set WD = CreateObject("Word.Application")
End If
'
lRow = 2
'
While Not strFileName = vbNullString
Set DOC = WD.Documents.Open(Filename:=strPath & strFileName, AddToRecentFiles:=False, Visible:=False)
'
'// Set FField to Nothing, attempt to reference the form field. If successful, return //
'// the .Result. If not, we don't have an unhandled error... //
Set FFIELD = Nothing
On Error Resume Next
Set FFIELD = DOC.FormFields("Text8")
On Error GoTo 0
If Not FFIELD Is Nothing Then
WKS.Cells(lRow, "A").Value = FFIELD.Result
Else
WKS.Cells(lRow, "A").Value = "Text8 NA"
End If
'
Set FFIELD = Nothing
On Error Resume Next
Set FFIELD = DOC.FormFields("Text20")
On Error GoTo 0
If Not FFIELD Is Nothing Then
WKS.Cells(lRow, "B").Value = FFIELD.Result
Else
WKS.Cells(lRow, "B").Value = "Text20 NA"
End If
'
DOC.Close False
lRow = lRow + 1
strFileName = Dir()
Wend
'
Application.ScreenUpdating = True
'
'// If we had to create WORD, then kill it.//
If bolKillWord Then
WD.Quit
End If
'
WKS.Range("A:B").Columns.AutoFit
' MsgBox Timer - a
Exit Sub
BailOut:
MsgBox "The active sheet is not a WorkSheet; exiting...", vbInformation Or vbOKOnly, "ACK!"
End Sub


Hopefully the comments will help, but don't hesitate to ask if unclear.

Mark

[beila00]

Ah, works like a charm. Thank you so much.