Replace a word in a Word Document (1 Viewer)

[Pleasure]

Dear friends.

I have a problem. I need to distribute some word files (documents) and each time I have to change some certain words inside it, depending on the situation, the distribution date etc.

I tried to link the word documents to my Ms Access database but then the results were not viewable and the document its self couldn't be prossesed anymore.

Then I thought that it would be much easier to place in the document some single words eg XXXXX for date and @@@@@ for name. Then there should be a way to programmaticaly open the document and change those XXXXX with the date I want (putted on a textbox of a form).

Any opinions? Any modules ?

Thanks a lot.
Sorry about my poor English
Best Regards
Theodore
Greece

 

[ByteMyzer]

The following function will do this:

Public Function wwReplace( _
    ByVal sFileName As String, _
    ByVal dDate As Date, _
    ByVal sName As String)

    Dim wwApp As Object
    Dim wwDoc As Object

    Set wwApp = CreateObject("Word.Application")

    Set wwDoc = wwApp.Documents.Open(sFileName)
    With wwDoc
        .Range.Text = Replace(.Range.Text, "XXXXX", _
            Format(dDate, "Short Date"), , , vbTextCompare)
        .Range.Text = Replace(.Range.Text, "@@@@@", _
            sName, , , vbTextCompare)
        .Close True
    End With
    Set wwDoc = Nothing

    wwApp.Quit
    Set wwApp = Nothing

End Function

Call the code with something like:

Call wwReplace("C:\MyDocument.doc", #10/17/2006#, "John Smith")

See if this solution works for you.

 

[Pleasure]

Thanks a lot my friend. I have tried your code and is working excellent except the Header and Footer section. After a long search in google and with a bit of modification I have tried this :

Public APWORD As Word.Application
Public Doc As Document
Private Sub Command2_Click()

Set APWORD = New Word.Application
APWORD.Visible = False
Set Doc = APWORD.Documents.Open("C:\File.doc")
Doc.Select
On Error GoTo ErrorOcurred

With APWORD.Selection.Find
.Text = "[" & Trim("XXXXX") & "]"
.Replacement.Text = Trim("Hello There")
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
APWORD.Selection.Find.Execute Replace:=wdReplaceAll

Dim HeaderFooter As Word.Range
For Each HeaderFooter In APWORD.ActiveDocument.StoryRanges
With HeaderFooter.Find
.Text = "[" & Trim("XXXXX") & "]"
.Replacement.Text = Trim("Hello There")
.Wrap = wdFindContinue
.Format = False
.Forward = True
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
HeaderFooter.Find.Execute Replace:=wdReplaceAll
Next


Doc.SaveAs ("c:\File2.doc")
Doc.Close False

ErrorOcurred:
End Sub


This code words also for the Header - Footer.

Thanks a lot. Keep coding ...