excel VBA to insert todays date in word

[dean.rogers]

Hey all,

What I would like to do is by use if excel VBA, I would like to have excel prompt word to enter in "todays date" where ever I have placed the respective variable. For instance, where ever I have [todays_date] located in my WordTemplate, then todays date will be inserted when I run my macro from excel. Below is the current code I have in place to map data from excel to word by finding a variable in word and replacing with a determined by a range in excel.

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
   
Set wrdDoc = wrdApp.Documents.Open("C:\Templates\WordTemplate.docx")

On Error Resume Next

With wrdDocSelection.Find
            .Text = "[excel_data]"
            .MatchWholeWord = False
            .Replacement.Text = ActiveWorkbook.Sheets("sheet1").Range("D3")
            .Execute , , , , , , , , , , wdReplaceAll

wrdApp.ActiveDocument.Save

I'm sure there is someway to do it but havent been able to find it anywhere.

Thank you for your help!!!

 

[Warship]

This will search the entire Word doc including headers and footers

Sub doDate()

    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
       
    Set wrdDoc = wrdApp.Documents.Open("C:\xltest\WordTemplate.docx")
    
    On Error Resume Next
    Call FindAndReplace("[excel_date]", ActiveWorkbook.Sheets("sheet1").Range("D3"))
    wrdApp.ActiveDocument.Save

End Sub

Private Sub FindAndReplace(fndTxt As String, repTxt As String)
    Dim rngStory
    For Each rngStory In ActiveDocument.StoryRanges
        With rngStory.Find
            .Text = fndTxt
            .Replacement.Text = repTxt
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
    Next rngStory
End Sub

 

[dean.rogers]

Hey Warship thanks for your reply.

In my example below,

With wrdDocSelection.Find             
   .Text = "[excel_data]"             
   .MatchWholeWord = False            
   .Replacement.Text = ActiveWorkbook.Sheets("sheet1").Range("D3")             
   .Execute , , , , , , , , , , wdReplaceAll

I actually put excel DATA as the example for which I mapped data from excel to word.

What i was looking for is some code that basically decides what todays date is either based on the computer itself or Word determining that today is may 2nd, 2012 and then replacing every variable with [todays_date] in the WordTemplate

Any thoughts?

PS I do like your code and will test it out to see if it works well for me because the code i have currently takes up more space.

 

[Warship]

Still using the FindAndReplace Sub posted previous.

Sub doDate()

    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
       
    Set wrdDoc = wrdApp.Documents.Open("C:\xltest\WordTemplate.docx")
    
    On Error Resume Next
    Call FindAndReplace("[todays_date]", Format(Date, "mm/dd/yyyy"))
    wrdApp.ActiveDocument.Save

End Sub

You can also do all at once:

Call FindAndReplace("[excel_data]", ActiveWorkbook.Sheets("sheet1").Range("D3"))
Call FindAndReplace("[todays_date]", Format(Date, "mm/dd/yyyy"))

 

[dean.rogers]

I just added the

Call FindAndReplace("[todays_date]", Format(Date, "mm/dd/yyyy"))</pre>

line of code to my existing code, however I got error "Sub or Function not defined" and it highlighted the code above.

 

[dean.rogers]

So I just applied some of your code and was successfully able to end up with todays date with this code

 With wrdDocSelection.Find
            'todays_date
            .Text = "[todays_date]"
            .MatchWholeWord = False
            .Replacement.Text = Format(Date, "mm/dd/yyyy")
            .Execute , , , , , , , , , , wdReplaceAll

 

[Warship]

I just added the

Call FindAndReplace("[todays_date]", Format(Date, "mm/dd/yyyy"))</pre>

line of code to my existing code, however I got error "Sub or Function not defined" and it highlighted the code above.

its looking for:

Private Sub FindAndReplace(fndTxt As String, repTxt As String)
    Dim rngStory
    For Each rngStory In ActiveDocument.StoryRanges
        With rngStory.Find
            .Text = fndTxt
            .Replacement.Text = repTxt
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
    Next rngStory
End Sub

And has to be in the Same Module or try delete "Private"

 

[dean.rogers]

Oh that makes total sense. Not sure why I didn't catch that. Well you have helped tremendously. I will be testing out your code to see if it formats the way that I need because it is much cleaner than the syntax that I am currently using. Thanks for your help!!!

 

[Warship]

You're quite welcome.. Anytime