From Excel Find Replace in Word

[kinas]

Hi,

I already googled and found many posts with code, but none of it have run with me
All I want to do is from VBA code in Excel, open a word document, make a find and replace in a word document (include headers, footers, ....).
Just this...
Can somebody help ?

I am using:
Excel 2003 (11. 2831.8221) SP3
Word 2003 (11. 8227.8221) SP3
Already activated in Tools -> References:
Microsoft Word 11 Object Library
Microsoft Excel 11 Object Library
Microsoft Office 11 Object Library

thanks in advance

[lucas]

Hello kinas,
Welcome to the forum. This will look for multiple exact strings such as bookmark1, etc. in a document and replace them with data from row 1 in the excel file. It then saves a copy of the word doc to any destination you choose(in the code). This basically leaves your original word file intact, basically used as a template.

Be sure to change the file path in the code in two locations to suit your need.

Open the excel file and change the paths, place the invoice.doc in the appropriate directory and then run the excel file......

Option Explicit
'the document
Dim Inv_doc As Object
'the application
Dim WD As Object
Sub Fill_In_Invoice_From_Excel()
'where is the template located
Const which_document As String = "C:\Temp\Invoice.doc"
'need an instance of word
Set WD = CreateObject("Word.Application")
WD.Visible = True
Set Inv_doc = WD.Documents.Open(which_document)
'*** code to manipulate your document
'replace the text in the document with text in cells
Call Change_Bookmark("bookmark1", Cells(1, 1).Value)
Call Change_Bookmark("bookmark2", Cells(1, 2).Value)
Call Change_Bookmark("bookmark3", Cells(1, 3).Value)
WD.Activate
Inv_doc.SaveAs "C:\Temp\invoice-test"
Inv_doc.Close
WD.Quit
Set Inv_doc = Nothing
Set WD = Nothing
End Sub
Sub Change_Bookmark(Template_Value As String, New_Value As String)
Dim oword As Object
For Each oword In Inv_doc.Words
If oword.Text = Template_Value Then
oword.Text = New_Value
End If
Next oword
Set oword = Nothing
End Sub

Edit: I just noticed the requirement for header and footer.......I didn't test the code for that but at least it will give you a start.

[kinas]

Hi,

Many thanks for your feedback, but doesn't work in Header....:help
Can you please help....

Thanks

[lucas]

jazzyt2u,

You seem to have to do this seperatly......the body of the document and then the header as shown in the attachment....

As macropod suggests in this thread:

http://www.vbaexpress.com/forum/showthread.php?t=21144&highlight=find+replace+header



As for the heading, have you considered putting the heading in the body of the document and using a STYLEREF field to replicate it in the header?


seems to be the consensus on solving your problem.

[kinas]

Sub Macro1()
Dim objWdApp As Word.Application
Dim objWdDoc As Word.Document
Dim objWdRange As Word.Range
Dim rgLoop As Word.Range
Dim secLoop As Word.Section
Dim hfLoop As Word.HeaderFooter

Set objWdApp = New Word.Application
Set objWdDoc = objWdApp.Documents.Open(Filename:="d:\my projects\teste.doc")
objWdApp.Visible = True
Dim oword As Object
For Each rgLoop In ActiveDocument.StoryRanges
Select Case rgLoop.StoryType
' Changes in Header
Case wdPrimaryHeaderStory
Call Find_and_Replace(rgLoop, "X1", "bzzzzzzzzzzzz")
.....



Sub Find_and_Replace(wheresearch As Range, searchfor As String, replacewith As String)
wheresearch.Find.Execute findText:=Trim(searchfor), replacewith:=Trim(replacewith), Replace:=wdReplaceAll
End Sub

[lucas]

Moved so one of the Word experts can maybe give some input.

[fumei]

You have a Type Mis-Match?

Where?

Is it here?

For Each rgLoop In ActiveDocument.StoryRanges