Import Data Directly from Word Forms to Access Tables

[Bergo]

I have highlighted the line in red. Looks like I am missing some code that identifies the second table that I want to pull data into.


Sub GetWordData()
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
strDocName = "C:\Documents and Settings\mwdosber\Desktop\Contracts\" & _
InputBox("Enter the name of the Word contract " & _
"you want to import:", "Import Contract")
Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(strDocName)
Set cnn = CurrentProject.Connection
rst.Open "tblContracts", cnn, _
adOpenDynamic, adLockOptimistic
With rst
.AddNew
!FirstName = doc.FormFields("fldFirstName").Result
!LastName = doc.FormFields("fldLastName").Result
!Company = doc.FormFields("fldCompany").Result
!Address = doc.FormFields("fldAddress").Result
!City = doc.FormFields("fldCity").Result
!State = doc.FormFields("fldState").Result
!ZIP = doc.FormFields("fldZIP1").Result & _
"-" & doc.FormFields("fldZIP2").Result
!Phone = doc.FormFields("fldPhone").Result
!SocialSecurity = doc.FormFields("fldSocialSecurity").Result
!Gender = doc.FormFields("fldGender").Result
!BirthDate = doc.FormFields("fldBirthDate").Result
!AdditionalCoverage = _
doc.FormFields("fldAdditional").Result
.Update

End With

rst.Open "tblSecurity", cnn, _
adOpenKeyset, adLockOptimistic

With rst
.AddNew
!Security = doc.FormFields("fldSecurity").Result
!Notes = doc.FormFields("fldNotes").Result
.Update
.Close

End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Contract Imported!"
Cleanup:
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub
ErrorHandling:
Select Case Err
Case -2147022986, 429
Set appWord = CreateObject("Word.Application")
blnQuitWord = True
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " _
& "No data imported.", vbOKOnly, _
"Document Not Found"
Case 5941
MsgBox "The document you selected does not " _
& "contain the required form fields. " _
& "No data imported.", vbOKOnly, _
"Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
End Select
GoTo Cleanup
End Sub

 

[SOS]

Before you open that, be sure to close the rst object:

rst.Close
rst.Open "tblSecurity", cnn, _
adOpenKeyset, adLockOptimistic

 

[Bergo]

It works! Thanks a bunch! Anything I can do to repay the favor?

 

[SOS]

It works! Thanks a bunch! Anything I can do to repay the favor?

As we say on the forums - just pay it forward. Help someone else when you can and it is all good.

 

[merkyworks]

I have been trying to make this work but I'm running into an issue with the type of Word "text field box" I use. I am using Access 2010 and Word 2010 on a Windows 7 machine. I have tried using Rich Text Content Controls, ActiveX Controls and Legacy Form Controls but I can only get the code below to work with Legacy Form Controls. When I use either Rich Text Content Controls or ActiveX Controls in the Word form I get an error message saying " Run-time error '5941': The requested member of the collection does not exist." I really need Rich Text Content Controls or ActiveX Controls to be working. I have upload the forms I'm working with so you can see exactly what is going on.

When the code runs the following libraries are checked:
Visual Basic For Applications
Micro. Access 14.0 Object lib.
OLE Automation
Micro. Office 14.0 Access batabase engine Object
Micro. ActiveX Data Object 6.0 lib.
Micro. Office 14.0 Object Lib.
Micro. Word 14.0 Object Lib.


//////////////////////////////////////////////////////////////////////////////////////

Option Compare Database
Option Explicit

Sub GetWordData()
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


strDocName = "C:\Users\(**YOUR USERNAME**)\Desktop\Contacts\" & _
InputBox("Enter the name of the Word contract" & _
" you want to import:", "Import Contract")


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

'can't decide if I want this in the code or not
'appWord.Visible = True

Set doc = appWord.Documents.Open(strDocName)
Set cnn = CurrentProject.Connection

rst.Open "Contacts", cnn, adOpenDynamic, adLockOptimistic


With rst
.AddNew

!FirstName = doc.FormFields("A").Result
!LastName = doc.FormFields("B").Result

'not using this until Word Form is completed/finalized
'!Company = doc.FormFields("C").Result
'!Address = doc.FormFields("D").Result
'!City = doc.FormFields("fldCity").Result
'!State = doc.FormFields("fldState").Result
'!ZIP = doc.FormFields("fldZIP1").Result & _
"-" & doc.FormFields("fldZIP2").Result
'!Phone = doc.FormFields("fldPhone").Result
'!SocialSecurity = doc.FormFields("fldSocialSecurity").Result
'!Gender = doc.FormFields("fldGender").Result
'!BirthDate = doc.FormFields("fldBirthDate").Result
'!AdditionalCoverage = _
'doc.FormFields("fldAdditional").Result

.Update
.Close

End With
doc.Close

If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Contract Imported!"

Cleanup:
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub

ErrorHandling:
Select Case Err
Case -2147022986, 429
Set appWord = CreateObject("Word.Application")
blnQuitWord = True

Resume Next

Case 5121, 5174
MsgBox "You must select a valid Word document. " _
& "No data imported.", vbOKOnly, _
"Document Not Found"

Case 5941
MsgBox "The document you selected does not " _
& "contain the required form fields. " _
& "No data imported.", vbOKOnly, _
"Fields Not Found"

Case Else
MsgBox Err & ": " & Err.Description

End Select
GoTo Cleanup
End Sub

//////////////////////////////////////////////////////////////////////////////////////


So what am I doing wrong?

 

[preddy2]

I am recieving a message saying "You must select a valid Word document..." Why am I getting this message and what should I do? I have tried a .doc and .docx file and neither are working.