Access XP & Word

OK. I have posted this on Access General, but I thought I might try here as well.


I have a word document with a macro in it.
I can open the Word document and run the macro from access,
But I want to incorperate this macro into my access db.
When I do this Access packs it in.
I know there is something wrong but can't find it.
Keeping in mind this works when it is in the word document.

Thank you in advance. I'm sure someone out there can help me.

----------------------------------------------------------------------
Dim appword As New Word.Application
Dim worddoc As Word.Document

Dim str As String
Set appword = New Word.Application
appword.Visible = True
Set worddoc = appword.Documents.Open("C:\canberrasales.doc")
With appword

.Selection.HomeKey unit:=wdStory
.Selection.Find.ClearFormatting
With .Selection
.Find.Text = "Date: "
.Find.Replacement.Text = ""
.Find.Forward = True
.Find.Wrap = wdFindContinue
.Find.Format = False
.Find.MatchCase = False
.Find.MatchWholeWord = False
.Find.MatchWildcards = False
.Find.MatchSoundsLike = False
.Find.MatchAllWordForms = False
End With

.Selection.Find.Execute
.Selection.EndKey unit:=wdLine
.Selection.MoveLeft unit:=wdWord, Count:=3, Extend:=wdExtend
.Selection.Copy
.Selection.HomeKey unit:=wdStory
.Selection.Find.ClearFormatting
With .Selection
.Find.Text = "Product Code"
.Find.Replacement.Text = ""
.Find.Forward = True
.Find.Wrap = wdFindAsk
.Find.Format = False
.Find.MatchCase = False
.Find.MatchWholeWord = False
.Find.MatchWildcards = False
.Find.MatchSoundsLike = False
.Find.MatchAllWordForms = False
End With

With .Selection
.Find.Execute
.InsertColumns
.MoveLeft unit:=wdCharacter, Count:=1
.TypeText Text:="Date"
.MoveDown unit:=wdLine, Count:=1
.Paste

'Isert Office Information
.HomeKey unit:=wdStory
.Find.ClearFormatting


.Find.Text = "Office: "
.Find.Replacement.Text = ""
.Find.Forward = True
.Find.Wrap = wdFindContinue
.Find.Format = False
.Find.MatchCase = False
.Find.MatchWholeWord = False
.Find.MatchWildcards = False
.Find.MatchSoundsLike = False
.Find.MatchAllWordForms = False
End With

With .Selection
.Find.Execute
.MoveRight unit:=wdCharacter, Count:=1
.MoveRight unit:=wdWord, Count:=1
.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
.Copy
.HomeKey unit:=wdStory
.Find.ClearFormatting


.Find.Text = "Product Code"
.Find.Replacement.Text = ""
.Find.Forward = True
.Find.Wrap = wdFindAsk
.Find.Format = False
.Find.MatchCase = False
.Find.MatchWholeWord = False
.Find.MatchWildcards = False
.Find.MatchSoundsLike = False
.Find.MatchAllWordForms = False
End With
.Selection.Find.Execute
.Selection.InsertColumns
.Selection.MoveLeft unit:=wdCharacter, Count:=1
.Selection.TypeText Text:="Office"
.Selection.MoveDown unit:=wdLine, Count:=1
.Selection.Paste

'Convert Table to delimited text
.Selection.Tables(1).Select
.Selection.Copy

.Documents.Add DocumentType:=wdNewBlankDocument
.Selection.Paste
.Selection.HomeKey unit:=wdStory
.Selection.Tables(1).Select
.Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
.ActiveDocument.SaveAs FileName:="c:\Canberra Sales.txt", _
FileFormat:=wdFormatText, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
.ActiveWindow.Close

End With