Pulling in Data from Word
 

Okay, so I figured out how to do it, and it works pretty nicely, but I'd still be glad to hear of any possible improvements. One thing I couldn't figure out how to do was make Excel the active applicaton again after having opened the word document. I want Excel to be the application on screen while the macro is running. The only solution I could come up with was setting word visible = false. Any way to just "activate" excel

Public Sub test(

Dim wd As Objec
Dim tempvar As Strin
Dim xlapp As Excel.Applicatio
Dim wdAPP As Word.Applicatio
Dim wdDoc As Word.Documen
Dim response As VbMsgBoxResul
Set xlapp = Excel.Applicatio
sRNM = Application.GetOpenFilename("Word Files (*.doc), *.doc"
If sRNM = False The
GoTo e
End I
' With Dialogs(xlDialogFileOpen
' If .Display The
' sRNM = WordBasic.FilenameInfo$(.Name, 1
' End I
' End Wit

Set wdAPP = CreateObject("Word.Application"
Set wdDoc = wdAPP.Documents.Open(sRNM

wdAPP.Visible = Fals


For i = 2 To 100
xlapp.Goto Reference:=Rows(i).Columns("B"
tempvar = Application.Selectio
With wdAPP.Selection.Fin
.ClearFormattin
.MatchWildcards = Fals
.MatchCase = Tru
.Forward = Tru
.Wrap = wdFindContinu
.Text = tempva
.Execut
End Wit
If wdAPP.Selection.Find.found = True The
With wdAPP.Selectio
.MoveLeft unit:=wdCell, Count:=
.selectcel
.Cop
End Wit
xlapp.Goto Reference:=Rows(i).Columns("A"
tempvar2 = Application.Selectio
If tempvar2 < "" The
response = MsgBox("There is already an ID here! Continue Running?", vbYesNo
If response = vbNo The
wdAPP.Quit savechanges = Fals
GoTo e
End I
Els
xlapp.ActiveSheet.Paste Destination:=Rows(i).Columns("A"
End I
End I
Nex
wdAPP.Visible = Tru
wdAPP.Quit savechanges = Fals
Set wdAPP = Nothin
Set wdDoc = Nothin
es
End Su

Pulling in Data from Word
 

Dan

Generally, when you create a Word Application object and open a document, it
won't show you the application unless you explicitly set Visible to True.
At least that's what happens on my machine using Off2000 and Win98SE. So my
experience is that Excel doesn't lose the focus.

It may happen, however, when you use a Select statement in Word. I don't
know of anyway to get it back, other than what you've done.

It tried to test your code a little more extensively, but the
..ClearFormatting line (or any line using the Find object) causes an Excel
crash.

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Dan" wrote in message
...
Okay, so I figured out how to do it, and it works pretty nicely, but I'd
still be glad to hear of any possible improvements. One thing I couldn't
figure out how to do was make Excel the active applicaton again after having
opened the word document. I want Excel to be the application on screen
while the macro is running. The only solution I could come up with was
setting word visible = false. Any way to just "activate" excel?

Public Sub test()

Dim wd As Object
Dim tempvar As String
Dim xlapp As Excel.Application
Dim wdAPP As Word.Application
Dim wdDoc As Word.Document
Dim response As VbMsgBoxResult
Set xlapp = Excel.Application
sRNM = Application.GetOpenFilename("Word Files (*.doc), *.doc")
If sRNM = False Then
GoTo es
End If
' With Dialogs(xlDialogFileOpen)
' If .Display Then
' sRNM = WordBasic.FilenameInfo$(.Name, 1)
' End If
' End With

Set wdAPP = CreateObject("Word.Application")
Set wdDoc = wdAPP.Documents.Open(sRNM)


wdAPP.Visible = False



For i = 2 To 1002
xlapp.Goto Reference:=Rows(i).Columns("B")
tempvar = Application.Selection
With wdAPP.Selection.Find
.ClearFormatting
.MatchWildcards = False
.MatchCase = True
.Forward = True
.Wrap = wdFindContinue
.Text = tempvar
.Execute
End With
If wdAPP.Selection.Find.found = True Then
With wdAPP.Selection
.MoveLeft unit:=wdCell, Count:=1
.selectcell
.Copy
End With
xlapp.Goto Reference:=Rows(i).Columns("A")
tempvar2 = Application.Selection
If tempvar2 < "" Then
response = MsgBox("There is already an ID here! Continue
Running?", vbYesNo)
If response = vbNo Then
wdAPP.Quit savechanges = False
GoTo es
End If
Else
xlapp.ActiveSheet.Paste Destination:=Rows(i).Columns("A")
End If
End If
Next
wdAPP.Visible = True
wdAPP.Quit savechanges = False
Set wdAPP = Nothing
Set wdDoc = Nothing
es:
End Sub