purpleblau
purpleblau

Reputation: 589

Open a Word Doc from Excel using VBA to find a Date text and replace it with a date text from a cell in Excel

I have a word doc with text and there is also a date text in there showing this format:

text text text 17.01.2020 text text text.

I want to replace the above date text with a cell from Excel that is also a date looking like this 18.01.2020.

So the VBA code should do the following:

1.Open word doc

2.find the text and replace it with the one from Excel

3.save Word doc.

Sub DocSearchandReplace()
Dim wdApp As Object, wdDoc As Object
Set wdApp = CreateObject("word.application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open("C:\sampletest.docx")
With wdDoc.Content.Find
  .Date = "???"
  .Replacement.Cell = "referencing a cell from Excel??"
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With

wdDoc.Save 'it however always prompt a word warning, how to surpress it?
wdDoc.Close 'it only closes the doc inside Word without closing the whole program.

Set wdApp = Nothing: Set wdDoc = Nothing
End Sub

I am not sure what to write in the .Date and .Replacement.Cell sections.

Upvotes: 0

Views: 718

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

The issue is your syntax is wrong. .Date and .Replacement.Cell properties don't exist in the Find object. Make sure to read the manual of the find object and don't invent properties.

The correct syntac according to Finding and Replacing Text or Formatting is something like:

With wdDoc.Content.Find 
    .ClearFormatting 
    .Text = "17.01.2020" 'your date to replace
    .Replacement.ClearFormatting 
    .Replacement.Text = ThisWorkbook.Worksheets("Sheet1").Range("A1").Text 'read value from sheet1 cell A1
    .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue 
End With

According to Cindys comment there exist wildcards matching in Word that is similar to using regular expressions.

With wdDoc.Content.Find 
    .ClearFormatting 
    .Text = "[0-9]{2}.[0-9]{2}.[0-9]{4}"  'will match ##.##.####
    .MatchWildcards = True 'makes sure the above wildcards are recognized
    .Replacement.ClearFormatting 
    .Replacement.Text = ThisWorkbook.Worksheets("Sheet1").Range("A1").Text 'read value from sheet1 cell A1
    .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue 
End With

Since you are using late binding you must either define your Word constants for the WdFindWrap and WdReplace enumeration before using them

Const wdReplaceAll As Long = 2
Const wdFindContinue As Long = 1

or replace them by their values

.Execute Replace:=2, Forward:=True, Wrap:=1

or set a reference to Word and use eary binding so they are defined automatically.

Upvotes: 2

Related Questions