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

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.

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 ...