Accessing word macros from excel

[peterhw]

I have written several macros in VBA / EXCEL but want to access a WORD (template / master) then replace various fields from my VBA EXCEL application database.
Example replace my_address_line1 (in the word document, with the actual address line from my text database accessed from VBA / Excel

Just not sure if I can do what I want to achieve!

When the WORD document is 'edited' then I wish to save and either Print or Email. I don't want to save macros into the final word document id sending by email (I guess that would be poor practice).

There doesn't seem to be an option to save a file in word which is macro enabled or disabled.

Just trying to get some pointers before I head off in the complete wrong direction!

[cytop]

If you need to edit the title, click the 'Edit post' link beneath the message and then click the 'Go advanced' button - you'll find an option to edit the title there... I edited it this time.

Your post is confusing. There's no need to access Word macros, everything can be done in Excel, and the resulting document can be saved without any macros in it.

I can't give specifics at the moment as I'm not at a computer (mobile phone), but I'll have a quick search for relevant threads here...

[peterhw]

.............), but I'll have a quick search for relevant threads here...

Many thanks.

[cytop]

Couldn't really find anything suitable (and simple enough). Following was quickly cobbled together and was tested. Comments in the code.

Sub FindReplaceSample() 
     
     '// To test this code, paste it into an Excel module
     
    Dim wrdApp As Object '// Word.Application    if using Early binding and reference set in project
    Dim wrdDoc As Object '// Word.Document       same
     
     '// This procedure assumes a range is selected/highlighted in Excel.
     '// The highlighted range provides the text to search for
     '// Adjacent cell in the next column provides the replacement text
    Dim r As Excel.Range 
     
     '// Start Word
    Set wrdApp = CreateObject("Word.Application") 
     
     '// Make visible and load template
     '// Set .Visible False if doinga lot of processing. This speeds things up
     '// as the screen does not have to be refreshed after every change
    With wrdApp 
        .Visible = True 
         '// Load a template - Change to suit
        .Documents.Add Template:="C:\Documents and Settings\xxx\Application Data\Microsoft\Templates\test.dot", NewTemplate:=False 
    End With 
     
     '// Set a reference to the active document
    Set wrdDoc = wrdApp.ActiveDocument 
     
     '// or - don't load a template, just open a doc instead
     '// Set wrdDoc = wrdApp.Documents.Open("C:\Foldername\Filename.doc")
     
     '// for each selected cell in the Excel sheet
    For Each r In Selection 
         
        With wrdDoc.Range.Find 
             
             '// Search value in cell
            .Text = r.Value 
             
             '// Replace with value in adjacent cell
             '// Needs to change to match your requirements
             '// I didn't have any details so just made up this...
            .Replacement.Text = r.Offset(0, 1).Value 
             
             '// Other parameters - check if are as required.
            .Forward = True 
            .Wrap = wdFindContinue 
            .Format = False 
            .MatchCase = False 
            .MatchWholeWord = False 
            .MatchWildcards = False 
            .MatchSoundsLike = False 
            .MatchAllWordForms = False 
             
             '// Go replace
            .Execute Replace:=wdReplaceAll 
             
        End With 
         
    Next 
     
     '// Need to add more code to save, email or whatever you want to do...
End Sub 

[peterhw]

Many thanks again.

[peterhw]

Just trying to implement something for myself and wondering how I could for example replace

my_replacements(1,1) with my_replacements(1,2) where my_replacements(1,1)= "replacement_1" and my_replacements(1,2) is the new text for this occurrence e.g. name
my_replacements(2,1) with my_replacements(2,2) where my_replacements(2,1)= "replacement_2" and my_replacements(1,2) is the new text for this occurrence e.g. address_line_1
my_replacements(3,1) with my_replacements(3,2) where my_replacements(3,1)= "replacement_3" and my_replacements(1,2) is the new text for this occurrence e.g. city
etc.

[cytop]

 
Dim iTemp As Integer 
 
For iTemp = 1 To 3 
     
    With wrdDoc.Range.Find 
         
         '// Search value in cell
        .Text = my_replacements(iTemp,1) 
         
        .Replacement.Text = my_replacements(iTemp,2) 
         
         '// Other parameters - check if are as required.
        .Forward = True 
        .Wrap = wdFindContinue 
        .Format = False 
        .MatchCase = False 
        .MatchWholeWord = False 
        .MatchWildcards = False 
        .MatchSoundsLike = False 
        .MatchAllWordForms = False 
         
         '// Go replace
        .Execute Replace:=wdReplaceAll 
         
    End With 
     
Next 

...?

[peterhw]

I seem to be struggling and your help is valued.

I had the basics of your example but my system seems to 'lock' then comes up with FILE is locked for editing, read only etc.

Doesn't seem to close. Needs an object.

 
Sub FindReplaceSample() '// To test this code, paste it into an Excel module
    Dim my_replacements(2, 2) 
    Dim wrdApp As Object '// Word.Application    if using Early binding and reference set in project
    Dim wrdDoc As Object '// Word.Document       same
    Set wrdApp = CreateObject("Word.Application") 
    Set wrdDoc = wrdApp.Documents.Open("D:\Myfiles\H Drive\Current Data\Personal\Miscellaneous\Problems.docx") 
    Dim iTemp As Integer 
    my_replacements(1, 1) = "council" 
    my_replacements(1, 2) = "xxxxxxx" 
    For iTemp = 1 To 1 
        With wrdDoc.Range.Find 
             '// Search value in cell
            .Text = my_replacements(iTemp, 1) 
            .Replacement.Text = my_replacements(iTemp, 2) 
             '// Other parameters - check if are as required.
            .Forward = True 
            .Wrap = wdFindContinue 
            .Format = False 
            .MatchCase = False 
            .MatchWholeWord = False 
            .MatchWildcards = False 
            .MatchSoundsLike = False 
            .MatchAllWordForms = False 
             '// Go replace
            .Execute Replace:=wdReplaceAll 
        End With 
    Next 
    appWd.ActiveDocument.SaveAs Filename:="D:\Myfiles\H Drive\Current Data\Personal\Miscellaneous\ProblemsA.docx" 
     ' Close this new word document
    appWd.ActiveDocument.Close 
    appWd.Quit 
     '// Need to add more code to save, email or whatever you want to do...
End Sub 

[cytop]

The file is already open... shows the reason why error handlers should be included in code.

Either:
Close any copies of the file you have open.
Or
Use TaskManager to check for running but hidden copies of Word and kill the processes or restart your machine.

[peterhw]

The file is already open... shows the reason why error handlers should be included in code.

Either:
Close any copies of the file you have open.
Or
Use TaskManager to check for running but hidden copies of Word and kill the processes or restart your machine.

Guess I am a little out of my depth and where to look.

I killed the process using TASKMANAGER then tried to run and failed trying to SAVE, QUIT etc stating there was no object.
Presumably there are some handlers in word for checking if the file or object is closed / open == I just don't seem to be thinking along the right path

Sub FindReplaceSample() '// To test this code, paste it into an Excel module
    Dim my_replacements(2, 2) 
    Dim wrdApp As Object '// Word.Application    if using Early binding and reference set in project
    Dim wrdDoc As Object '// Word.Document       same
    Dim iTemp As Integer 
    Set wrdApp = CreateObject("Word.Application") 
    Set wrdDoc = wrdApp.Documents.Open("D:\Myfiles\H Drive\Current Data\Personal\Miscellaneous\Problems.docx") 
    Set wrdDoc1 = wrdApp.ActiveDocument 
    my_replacements(1, 1) = "council" 
    my_replacements(1, 2) = "xxxxxxx" 
     
    For iTemp = 1 To 1 '       reaches breakpoint 1 OK
        With wrdDoc.Range.Find 
             '// Search value in cell
            .Text = my_replacements(iTemp, 1) 
            .Replacement.Text = my_replacements(iTemp, 2) 
             '// Other parameters - check if are as required.
            .Forward = True 
             '// Go replace
            .Execute Replace:=wdReplaceAll '    reaches breakpoint 2 here
        End With 
    Next 
     '   fails with needs object - wrdDoc & wrdDoc1 appears as "Document1"
    appWd.ActiveDocument.SaveAs Filename:="D:\Myfiles\H Drive\Current Data\Personal\Miscellaneous\ProblemsA.docx" 
     ' Close this new word document
    appWd.ActiveDocument.Close 
    appWd.Quit '// Need to add more code to save, email or whatever you want to do...
End Sub