Import part of a Word Doc to Access Field

[donaldmaloney]

I have an Access application that opens a word document, searches for text and gets the next paragraph and inserts it to an Access field.

I need to be able to do this with Dialog box but the box hides behind the access forms, doesn't show the document and locks up the access application.

I have now totally messed up all the code and get an illegal error that closes all my applications.

Help. anyone.

my experience with VBA and Word searches is very basic as you can see here

Private Sub Command3_Click()
'Stop
On Error GoTo Err_Command3_Click
Dim WordObj As Word.Application
Dim WordDocNameName As String
XYesButton = 0

' Start Microsoft Word and open the document.
Set WordObj = CreateObject("Word.Application")

' get vendor WordDocName EmployeeCodeID + "WORDDOCNAME" + ".DOC"
WordDocNameName = "c:\" & Me.Parent.EmployeeCodeIDField & "WordDocName.doc"

'WordObj.Documents.Open "C:\Wordtest.doc", , ReadOnly


WordObj.Documents.Open WordDocNameName, _
ConfirmConversions:=False, _
ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto


' start at the first page of the document




WordObj.Selection.Goto What:=wdGoToPage, Which:=wdGoToFirst


' search for the text

If TextToFindHighlight = "" Then
TextToFindHighlight = Me.TextToFindField
Else
End If

'With Dialogs
' .Application.FindKey.Context = TextToFindHighlight

' End With

' NEW
DoCmd.Minimize

With WordObj.Dialogs(wdDialogEditFind)
.Find = TextToFindHighlight
' .Application.Activate
'
' '.Modal
.Show
' .Top


End With

Do Until XYesButton = 1
“ Button on form to get next occurrence of text
'Stop


' Sub findtext()
'
' findtext Macro
' Macro recorded 5/25/05 by Don
'
' ChangeFileOpenDirectory "C:\"
' Documents.Open FileName:="DASWordDocName.doc", ConfirmConversions:=False, _
' ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
' PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
' WritePasswordTemplate:="", Format:=wdOpenFormatAuto
' Selection.Find.ClearFormatting

' Code was open
' With Selection.Find
' .Execute = True
' .Text = TextToFindHighlight
' .Replacement.Text = ""
' .Forward = True
' .Wrap = wdFindContinue
' .Format = False
' .MatchCase = False
' .MatchWholeWord = False
' .MatchWildcards = False
' .MatchSoundsLike = False
' .MatchAllWordForms = False
' End With

' to here
' Selection.Find.Execute
' With Selection.Find
' .Text = "the"
' .Replacement.Text = ""
' .Forward = True
' .Wrap = wdFindContinue
' .Format = False
' .MatchCase = False
' .MatchWholeWord = False
' .MatchWildcards = False
' .MatchSoundsLike = False
' .MatchAllWordForms = False
' End With
Get_next_text:
If vbOK Then
GoTo Get_Text
Else
Selection.Find.Execute
GoTo Get_next_text
End If
Get_Text:











If WordObj Is Nothing Then
MsgBox "A problem exists in charging MS Word."
Exit Sub
End If
‘FormWordDocNameText is field on form that has Word doc Page number
[FormWordDocNameText.WordDocNamePage] = WordObj.Selection.Information(wdActiveEndPageNumber)
Me.WordDocNamePageField.Requery
'Stop
' get the next nine sentences
With WordObj.Selection
.StartOf Unit:=wdParagraph, Extend:=wdMove
.MoveDown Unit:=wdParagraph, Count:=9, Extend:=wdExtend
End With
Debug.Print WordObj.Selection.Range
Me.WordDocNameTextField = WordObj.Selection.Range
‘WordDocNameTextField is field on form where text is to be put
'Stop
' Close and save the document.
'WordObj.ActiveDocument.Close SaveChanges:=wdSaveChanges
' go back to the start
' later try it without these next three lines

'With WordObj.Selection
' .GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=4

'End With


DoCmd.GoToControl YesButton
‘Yes button is control on form that is set to get next occurrence of search text ( like get next)
‘ and is set to 1 when text is correct - to stop forward search of document
Loop
' Quit Microsoft Word and release the object variable.

WordObj.Quit SaveChanges:=wdDoNotSaveChanges


Set WordObj = Nothing
ActiveDocument.Close

DoCmd.Maximize

'WordObj.Quit
'WordObj.Documents.Close
'Set WordObj = Nothing
'End Function
Exit_Command3_Click:
Exit Sub

Err_Command3_Click:
MsgBox Err.Description
Resume Exit_Command3_Click
End Sub