1 Replies - 4332 Views - Last Post: 27 October 2011 - 09:05 AM Rate Topic: -----

#1 jackson182  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 1
  • Joined: 26-October 11

Excel VBA Word Find & Replace Multiple

Posted 26 October 2011 - 03:09 PM

I have written a bit of code that will open a word document and find certain words and replace them with values within excel. The below code works great however it is really slow as the creating the word object seams to take some time. I have tried to set about making this quicker and the idea I had was to only call the createobject("word.application") once. This works however the values within the word documents don't change?

This works!
Sub findreplace()


Const conFirstRow = 1
Const conCOLformid = 1
Const conCOLfilename = 3


Dim strformid As String
Dim strBuildingid As String
Dim strAddress As String
Dim strName As String
Dim strDate As Date
Dim strDateyear As Date
Dim strFilename As String
Dim i As Integer

strBuildingid = Cells(1, 1)


MkDir "C:\Documents and Settings\jackson.matthews\Desktop\RA 2011\" & strBuildingid

Sheets("Sheet1").Select

i = 1

strformid = Cells(conFirstRow + i, conCOLformid)


While strformid <> ""

Sheets("Sheet2").Select

strAddress = Cells(2, 2)
strName = Cells(3, 2)
strDate = Cells(4, 2)
strDateyear = Cells(5, 2)

Sheets("Sheet1").Select

strFilename = Cells(conFirstRow + i, conCOLfilename)

Set wdApp = CreateObject("Word.application")
Set wdDoc = wdApp.Documents.Open(Filename:="C:\Documents and Settings\jackson.matthews\Desktop\RA 2011\templates\" & strformid & ".doc")


    wdApp.Visible = True
    ErrorType = "Find Replace"
    
    wdApp.Selection.Find.Execute
    With wdApp.Selection.Find
       .Text = "reviewaddress"    ' Enter company name in agreement
        .Replacement.Text = strAddress
        .Execute Replace:=wdReplaceAll
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

    End With
    
        wdApp.Selection.Find.Execute
    With wdApp.Selection.Find
       .Text = "reviewname"    ' Enter company name in agreement
        .Replacement.Text = strName
        .Execute Replace:=wdReplaceAll
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

    End With
    
    wdApp.Selection.Find.Execute
    With wdApp.Selection.Find
       .Text = "reviewdate"    ' Enter company name in agreement
        .Replacement.Text = strDate
        .Execute Replace:=wdReplaceAll
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

    End With
    
    wdApp.Selection.Find.Execute
    With wdApp.Selection.Find
       .Text = "dateyear"    ' Enter company name in agreement
        .Replacement.Text = strDateyear
        .Execute Replace:=wdReplaceAll
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

    End With

    With wdDoc
    .SaveAs ("C:\Documents and Settings\jackson.matthews\Desktop\RA 2011\" & strBuildingid & "\" & strFilename)
    .Close
    End With
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing

i = i + 1

strformid = Cells(conFirstRow + i, conCOLformid)

Wend
 
End Sub



This is what I am trying?


Sub findreplacetest()


Const conFirstRow = 1
Const conCOLformid = 1
Const conCOLfilename = 3


Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim strformid As String
Dim strBuildingid As String
Dim strAddress As String
Dim strName As String
Dim strDate As Date
Dim strDateyear As Date
Dim strFilename As String
Dim i As Integer

strBuildingid = Cells(1, 1)
strAddress = Cells(2, 2)
strName = Cells(3, 2)
strDate = Cells(4, 2)
strDateyear = Cells(5, 2)

MkDir "C:\Documents and Settings\jackson.matthews\Desktop\RA 2011\" & strBuildingid

Sheets("Sheet1").Select

i = 1

strformid = Cells(conFirstRow + i, conCOLformid)

Set wdApp = CreateObject("Word.application")

While strformid <> ""

strFilename = Cells(conFirstRow + i, conCOLfilename)


Set wdDoc = wdApp.Documents.Open(Filename:="C:\Documents and Settings\jackson.matthews\Desktop\RA 2011\templates\" & strformid & ".doc")

    With wdDoc
        wdApp.Visible = True
        ErrorType = "Find Replace"
    
        wdApp.Selection.Find.Execute
        With wdApp.Selection.Find
            .Text = "reviewaddress"    ' Enter company name in agreement
            .Replacement.Text = strAddress
            .Execute Replace:=wdReplaceAll
            .Text = "reviewname"    ' Enter company name in agreement
            .Replacement.Text = strName
            .Execute Replace:=wdReplaceAll
            .Text = "reviewdate"    ' Enter company name in agreement
            .Replacement.Text = strDate
            .Execute Replace:=wdReplaceAll
            .Text = "dateyear"    ' Enter company name in agreement
            .Replacement.Text = strDateyear
            .Execute Replace:=wdReplaceAll
        End With
        wdApp.Selection.Find.Execute
        
    
        .SaveAs ("C:\Documents and Settings\jackson.matthews\Desktop\RA 2011\" & strBuildingid & "\" & strFilename)
        .Close
    
    End With

i = i + 1

strformid = Cells(conFirstRow + i, conCOLformid)

Wend

wdApp.Quit

End Sub




Any ideas?

Many thanks

Jackson

Is This A Good Question/Topic? 0
  • +

Replies To: Excel VBA Word Find & Replace Multiple

#2 BobRodes  Icon User is offline

  • Your Friendly Local Curmudgeon
  • member icon

Reputation: 574
  • View blog
  • Posts: 2,989
  • Joined: 19-May 09

Re: Excel VBA Word Find & Replace Multiple

Posted 27 October 2011 - 09:05 AM

The reason it's slow is because of all the interprocess communication. Every time you mention the wdApp variable in your code, you have to marshal data between two exe's. Even if you resolve the pointer with the With statement, you still have to marshal each time.

Now, I don't know if replace all can happen once on the other side, or whether it really does a loop of finds and replaces. I suspect it probably does the loop, and marshals once for each instance of a replace.

A way around this is to create the find and replace routine in Word VBA, and call it with VB6. That way, only the procedure call itself is marshaled and the actual work goes on entirely in the Word process.

If you want to find out whether replace all is one interprocess call per execute, or one per find and replace, you can create a proc in VBA that wraps the replace all function and call it from the VB6 process. If it runs a lot faster, then you've reduced cross-process calls significantly, and that means that replace all is one call per find and replace. if not, it's one call per execute.

Hope this is understandable. :) Let me know if you need clarification.

This post has been edited by BobRodes: 27 October 2011 - 09:06 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1