Open Existing Word Document From Excel?

[carpman]

I would like to open an existing word document using a command button click. I am new to VBA and have been guessing my way around to this point, this is a bit tougher for me. I am wanting to open the word document and merge data from excel, so a fully automated open and merge sequence would be great if possible.

 

[IRstuff]

This was a very specific application of opening a Word document from a Lowtran atmospheric transmission model, finding a specific phrase in the output, copying the data value and pasting it into an Excel sheet. The analysis program is iterated over 25 distance values, so there's a 25 iteration copy loop. It's pretty kludgy; I wrote it 4 yrs ago and I'm not even sure I can remember why everything is the way it is. It was mostly macro recorded and glued together with some heavy-duty research.

Good Luck

TTFN

Sub LT7()
'
' Lowtran7 macro to paste Lowtran transmission results into Excel Spreadsheet
' Macro recorded 1/23/98 by mei
'

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim ColIndex, RowIndex, StartRow, Done
Dim FileName, SheetName

Dim WordApp As Object
Dim Trans As String

Set WordApp = GetObject(, "word.application&quot

FileName = ActiveWorkbook.Name
SheetName = ActiveSheet.Name

Sheets(SheetName).Select
Done = False
ColIndex = ActiveCell.Column
RowIndex = ActiveCell.Row
StartRow = RowIndex

Cells(RowIndex, ColIndex).Select
With WordApp.Selection.Find
.Text = "transmittance ="
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

For Index = 1 To 25
WordApp.Selection.Find.ClearFormatting
WordApp.Selection.Find.Execute
WordApp.Selection.MoveRight unit:=wdCharacter, Count:=1
WordApp.Selection.MoveRight unit:=wdSentence, Count:=1, Extend:=wdExtend
' WordApp.Selection.Copy
Trans = WordApp.Selection.Text
WordApp.Selection.MoveDown unit:=wdLine

Cells(RowIndex, ColIndex).Select
' ActiveSheet.Paste
ActiveCell.Formula = Trans

RowIndex = RowIndex + 1
Next
Cells(StartRow, ColIndex).Select
End Sub