Import MS Word form fields into MS Access

I have created an application form using MS Word and a whole bunch of form fields, and I have an Access db that can import all the data I need from this Word doc, thanks to this:

http://msdn.microsoft.com/en-us/library/aa155434%28office.10%29.aspx

Now everything works just fine (I even managed to get it to import into multiple tables!), but the problem with the above is that I have to manually enter the name of each file one at a time... which is fine if it's just a case of importing the application form as it comes in... but I have quite a lot sitting in a folder that needs entered into the database.

Then I found this:

How to show "Open File" Dialog in Access 2007 VBA?

I've tried to tweak and merge the two to make it work... but as you can guess, to no avail... (it doesn't help when I'm very much an Access novice!)

What I am looking to do is to be 开发者_JAVA技巧able to import a bunch of Word docs / form fields into MS Access by using the Open / Select file dialogue box... what I've got works, but I'd like to make it easier to work with!

Thanks everyone Jake

##### Codes I been using

Option Compare Database

Option Explicit

Private Sub cmdFileDialog_Click()

' This requires a reference to the Microsoft Office 11.0 Object Library.

Dim fDialog As Office.FileDialog
Dim varFile As Variant

Dim appWord As Word.Application
Dim doc As Word.Document
' Dim cnn As New ADODB.Connection
' Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean

' Clear the list box contents.
' Me.FileList.RowSource = ""

' Set up the File dialog box.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow the user to make multiple selections in the dialog box.
.AllowMultiSelect = True

' Set the title of the dialog box.
.Title = "Select One or More Files"

' Clear out the current filters, and then add your own.
.Filters.Clear
.Filters.Add "Microsoft Word", "*.DOC"
.Filters.Add "All Files", "*.*"

' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
' Loop through each file that is selected and then add it to the list box.
For Each varFile In .SelectedItems
' Me.FileList.AddItem varFile

Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(varFile)

' cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
'     "Data Source=M:\Medical\GPAppraisal\Contacts & Databases\" & _
'     "AppForm.mdb;"
' rst.Open "tbl_Applicants", cnn, _
'     adOpenKeyset, adLockOptimistic

' With rst
.addnew
!Title = doc.FormFields("wTitle").Result
!FirstName = doc.FormFields("wFirstName").Result
!LastName = doc.FormFields("wLastName").Result
!Address1 = doc.FormFields("wAddress1").Result
!Address2 = doc.FormFields("wAddress2").Result
!Address3 = doc.FormFields("wAddress3").Result
!City = doc.FormFields("wCity").Result
!PostCode = doc.FormFields("wPostCode").Result
!Email = doc.FormFields("wEmail").Result
!Phone1 = doc.FormFields("wPhone1").Result
!Phone2 = doc.FormFields("wPhone2").Result
!LM = doc.FormFields("wLM").Result
!LMAddress1 = doc.FormFields("wLMAddress1").Result
!LMAddress2 = doc.FormFields("wLMAddress2").Result
!LMAddress3 = doc.FormFields("wLMAddress3").Result
!LMCity = doc.FormFields("wLMCity").Result
!LMPostCode = doc.FormFields("wLMPostCode").Result
!LMEmail = doc.FormFields("wLMEmail").Result
!LMPhone = doc.FormFields("wLMPhone").Result
!LMOK = doc.FormFields("wLMOK").Result
!Probity = doc.FormFields("wProbity").Result
!Practising = doc.FormFields("wPractising").Result
!Signature = doc.FormFields("wSignature").Result
!AppDate = doc.FormFields("wAppDate").Result
!e2011012028 = doc.FormFields("w2011012028").Result
!e2011021725 = doc.FormFields("w2011021725").Result
!e2011030311 = doc.FormFields("w2011030311").Result
!e2011031625 = doc.FormFields("w2011031625").Result
!e20110203 = doc.FormFields("w20110203").Result
!e20110211 = doc.FormFields("w20110211").Result
!e20110322 = doc.FormFields("w20110322").Result
!e20110330 = doc.FormFields("w20110330").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Application Imported!"

Cleanup:
' Set rst = Nothing
' Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing

Next
Else
   MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub

#

I've tried to mess with me.tables and me!forms and .add etc etc - obviously I'm a complete novice here!!!

What I want is to be able to import data from form fields in a Word Doc into a MS Access table (which I have managed to do with the first URL in my original post above); by means of selecting the Word doc from the Open/Select dialogue box, instead of manually entering the names of each Word doc.

My apologies if it sounds obvious or simple - Access is not my strong point by any means!

---

Before I begin I didn't understand why you have so many uncommented lines (lines beginnig mit ' ) in you code example. I assume that most of those lines would normally not bei uncommented and be part of the working code. Or are there artifacts of the Stack Overflow Editor?

I see a few problems, that might to guide you to a solution.

1) When you use

With fDialog

you let this 'open' until the end of the code (even using a second With in between). I would recommend to set you corresponding 'End With' right after you no longer require it. Remeber (or take note): The

With fDialog
   [... something]
   ' Set the title of the dialog box.
   .Title = "Select One or More Files"

is really just a shorthand for

fDialog.Title

(i.e. a "naked" . means, that it has to be appendend to the object in the With) so you could do away with the "With" entirely. IN you example I would set the "End With" right before

If .Show = True Then

and then use

If fDialog.Show = True Then

2) I would set

Set appWord = GetObject(, "Word.Application")

outside your For Each loop (don't forget to take Set appWord = Nothing outside the loop as well). Remember that with GetObject you need an runnig Word-instance, otherwise you might want to use

Set appWord = CreateObject("Word.Application")

or to have it both ways, try to get a Word-object, and if it is not available (i.e. Err.Number = 429) create a new one.

On Error Resume Next
Set appWord = GetObject(, "Word.Application")

If Err.Number = 429 Then
    Set appWord = CreateObject("Word.Application")
End If
On Error GoTo 0

3) When working or at least while developping using automation I would always set

objword.Visible = True

so you see error messages or other problems right within Word.

HTH for the next steps (in case you have this problem anymore) Andreas