It's a bit Heath Robinson, but the following macro appears to do the job of
creating a comma delimited text file TargetDoc.txt from a folder full of
similar completed form documents. I would have posted it earlier, but there
was a persistent minor error that I couldn't get my head around, so I went
for the lure of a sunny day, deserted roads and a fast car instead, before
it gets too hot to enjoy such pleasures. The web page may take a little
longer
Sub ExtraData from forms()
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")
ChangeFileOpenDirectory DocDir
Do While DocList <> ""
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
Set TargetDoc = Documents.Open("TargetDoc.txt", False)
With Selection
.EndKey Unit:=wdStory
.Paste
End With
TargetDoc.Close SaveChanges:=wdSaveChanges
DocList = Dir$()
Loop
Application.ScreenUpdating = True
Documents.Open "TargetDoc.txt", False
Exit Sub
err_FolderContents:
MsgBox Err.Description
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>