|
Extract data from
protected forms |
|
|
|
While Word 2007 has introduced a new set of
forms tools, the implementation for the moment leaves a lot to be
desired, but there are still many users creating protected forms in Word
2002/3. Having prepared your forms
and filled them, the next step is often to extract
the completed data for use in a spreadsheet. Word provides the option
(Tools > Options > Save) to save only the data from forms. This page
extends that option to work on a folder full of similar forms to create
a comma delimited text file that can be loaded into standard spreadsheet
packages such as Excel.
Using the following simple form as an
example: |
|
|
|
|
the macro requires two empty text files -
here DataDoc.txt which is used as a temporary repository
for the data from each form, and TargetDoc.txt which will be the
completed comma delimited text file. No changes are made to the
completed form documents.
To create the empty text files, Use Windows
Explorer to navigate the the folder where the completed forms are filed.
Right click in the right file window and select New > Text Document
(see below). |
|
|
|
|
This will produce a new
filename similar to that above, already highlighted for renaming. Rename
the file TargetDoc.txt. Repeat for DataDoc.txt.
Run the macro and each document will be
opened in turn and the data saved to DataDoc.txt. This text file
is then opened and the content copied and pasted to TargetDoc.txt.
The result from the sample forms would be: |
|
 |
|
|
Sub
ExtractDataFromForms()
Dim DocList As String
Dim DocDir As String
Dim DataDoc As
Document
Dim TargetDoc As
Document
Dim fDialog As
FileDialog
Set fDialog =
Application.FileDialog(msoFileDialogFolderPicker)
On Error GoTo err_FolderContents
With fDialog
.Title = "Select
Folder containing the completed form documents and click OK"
.AllowMultiSelect =
False
.InitialView =
msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir =
fDialog.SelectedItems.Item(1)
If Right(DocDir, 1) <> "\" Then
DocDir = DocDir + "\"
End With
If Documents.Count > 0
Then
Documents.Close
SaveChanges:=wdPromptToSaveChanges
End If
Application.ScreenUpdating = False
DocList = Dir$(DocDir & "*.doc?")
Set TargetDoc = Documents.Open(DocDir & "TargetDoc.txt",
False)
Do While DocList <> ""
ChangeFileOpenDirectory DocDir
Documents.Open
DocList
With ActiveDocument
.SaveFormsData = True
.SaveAs FileName:="DataDoc.txt", _
FileFormat:=wdFormatText, _
SaveFormsData:=True
.Close SaveChanges:=wdDoNotSaveChanges
End With
Set DataDoc = Documents.Open("DataDoc.txt",
False)
With Selection
.WholeStory
.Copy
End With
DataDoc.Close
SaveChanges:=wdDoNotSaveChanges
TargetDoc.Activate
With Selection
.EndKey Unit:=wdStory
.Paste
End With
TargetDoc.Save
DocList = Dir$()
Loop
Application.ScreenUpdating = True
Exit Sub
err_FolderContents:
MsgBox Err.Description
End Sub
|
|
Note: |
The macro will also run in Word 2007 using forms in
Word "*.doc" and "*.docx" formats. |
