Find/Replace macro from excel into Word

[Matt]

All:

I am running a macro from excel that opens a word document on c:\
directory and does a find and replace in the word document from the
criteria in certain cells in the excel file. Where I am having trouble
is with the find and replace information. I have set up a loop to save
on code and calls a second sub. I am getting a debug issue when it
calls the second sub called Sub DoFindReplace(...). Can someone tell
me what is wrong with this sub or is there something wrong with the
first sub. If I have left something out or you need more information
let me know and I will respond. Thanks in advance.
~Matt



Private Sub CommandButton2_Click()

Dim sCustomer As String
Dim sJobDate As String
Dim sLease As String
Dim sVessel As String
Dim sTreatment As String
Dim sField As String
Dim sFormation As String
Dim sWellNo As String
Dim sPE_SalesOrderNo As String
Dim sPeEngr1 As String
Dim sCustomerEngr As String
Dim sAccountRep As String
Dim appWD As Object
Set appWD = CreateObject("Word.Application")

Sheets("SC Database").Activate
sCustomer = ActiveSheet.Range("Customer")
sJobDate = ActiveSheet.Range("JobDate")
sLease = ActiveSheet.Range("Lease")
sVessel = ActiveSheet.Range("Vessel")
sTreatment = ActiveSheet.Range("Treatment")
sField = ActiveSheet.Range("Field")
sFormation = ActiveSheet.Range("Formation")
sWellNo = ActiveSheet.Range("Well")
sPE_SalesOrderNo = ActiveSheet.Range("PE_SalesOrderNo")
sPeEngr1 = ActiveSheet.Range("PeEngr1")
sCustomerEngr = ActiveSheet.Range("CustomerEngr")
Sheets("Input").Activate
sAccountRep = ActiveSheet.Range("AccountRep")

appWD.Visible = True
appWD.Documents.Open Filename:="C:\CD Jewel Case Label.doc"

'Remove Date with correct job information
Call DoFindReplace(FindText:="Date", ReplaceText:=sJobDate)
MsgBox "Is this working? " & sCustomer, vbOKOnly, "Is this
working?"
'Remove Lease with correct job information
Call DoFindReplace(FindText:="Lease", ReplaceText:=sLease)
'Remove Vessel with correct job information
Call DoFindReplace(FindText:="Vessel", ReplaceText:=sVessel)
'Remove Treatment with correct job information
Call DoFindReplace(FindText:="Treatment", ReplaceText:=sTreatment)
'Remove Field with correct job information
Call DoFindReplace(FindText:="Field", ReplaceText:=sField)
'Remove Formation with correct job information
Call DoFindReplace(FindText:="Formation", ReplaceText:=sFormation)
'Remove Well with correct job information
Call DoFindReplace(FindText:="Well", ReplaceText:="Well # " &
sWell)
'Remove Sales Order with correct job information
Call DoFindReplace(FindText:="Sales Order", ReplaceText:="SO# " &
sPE_SalesOrderNo)

' Brings cursor to top of page.
Selection.HomeKey Unit:=wdStory

End Sub


Sub DoFindReplace(FindText As String, ReplaceText As String)

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = FindText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
'Keep going until nothing found
.Execute Replace:=wdReplaceAll
Loop
'Free up some memory
'ActiveDocument.UndoClear
End With

End Sub

 

[Cindy M -WordMVP-]

Hi Matt,

I am running a macro from excel that opens a word document on c:\
directory and does a find and replace in the word document from the
criteria in certain cells in the excel file. Where I am having trouble
is with the find and replace information. I have set up a loop to save
on code and calls a second sub. I am getting a debug issue when it
calls the second sub called Sub DoFindReplace(...). Can someone tell
me what is wrong with this sub or is there something wrong with the
first sub. If I have left something out or you need more information
let me know and I will respond.

We need to know the version of Office and the exact message you're
getting. (I assume "debug issue" means you're getting some kind of error
message.)

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail

 

[Matt]

Hi Matt,

We need to know the version of Office and the exact message you're
getting. (I assume "debug issue" means you're getting some kind of error
message.)

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister


This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail

Cindy:

I am using office 2003 (Word 2003 and Excel 2003). Thanks for helping
out.

I have changed the code to try and isolate the issue. Here is the new
code.

Sub FindandReplace()
Dim appWD As Object
Set appWD = CreateObject("Word.Application")

appWD.documents.Open("C:\Doc2.doc").Application.Visible = True
With appWD.Visible = True
With appWD.Application.Selection.Find
.Text = "Date"
.Replacement.Text = "Fight"
.Forward = True
.Wrap = wdFindContinue
End With
Do While appWD.Application.Selection.Find.Execute
appWD.Application.Selection.Find.Execute Replace:=wdReplaceAll
Loop
End With

End Sub

 

[Cindy M -WordMVP-]

Hi Matt,

I am using office 2003 (Word 2003 and Excel 2003). Thanks for helping
out.

I have changed the code to try and isolate the issue.

But you still haven't told us what the issue is.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail