Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 302
  • Last Modified:

Need Outlook macro to populate a Word document

Hello experts,

I'm hoping someone can help me out with this.  I have a client who uses their Outlook 2007 Public Folders to store several business wide contacts.  I need to set up way the users can print individual contacts to a custom report as easy as possible, preferably with a single click.

I'm thinking a button or menu item that will programatically open a pre-made Word template and populate the custom fields.

I realize I can do this with Mail Merge inside Outlook and point it to my Word template, but that takes too long I need to do this with a single click, for the end users.

Any ideas?
0
NLX
Asked:
NLX
  • 14
  • 13
1 Solution
 
David LeeCommented:
Hi, NLX.

I might be able to help with this.  When you say "report" do you mean a list of the contacts or are you talking about integrating contact information into a report?
0
 
NLXAuthor Commented:
BlueDevilFan,

Thanks for the reply.  I was beginning to lose faith on this question.  I meant the latter, integrating a single contact information into a custom report.

I ended up finding another one of your posts describing a process that seems to be working.

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_21913546.html

I implemented the above but could use some help tweaking it.  Currently, the macro opens a word document and populates it with the contact info.  Pretty cool.  Its leaving the word document open and actually all the text is selected.  

Here's what I would like to do:

Protect the Word document so the users can't accidentally save the merged document over top of my 'template'.  (I'm thinking an actual Word .dotx template would work)

Not have the users have to see the document and then print it.  Is it possible to programmatically execute a print document command so the only thing the users sees is the Print To Dialog Box.  Once printed the document could close (without saving)?

Thanks for your help on this.



0
 
David LeeCommented:
"Protect the Word document so the users can't accidentally save the merged document over top of my 'template'.  (I'm thinking an actual Word .dotx template would work)"

A template might work.  Another option is to include a command that saves the new document to a file name of your choice thereby preventing the user from overwriting the template.


"Not have the users have to see the document and then print it.  Is it possible to programmatically execute a print document command so the only thing the users sees is the Print To Dialog Box.  Once printed the document could close (without saving)?"

Yes, that's doable.  Try replacing

    wrdApp.Visible = True

with

    wrdDoc.PrintOut False
    wrdDoc.Close False

This should print the document to the default printer, then close it without saving.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
NLXAuthor Commented:
Thanks.  

I actually got it working already with a Word .dotx template.

But, I'm having trouble finding the Word object model.  When in the VB editor I can see the Outlook object model.  Meaning, after the period all the properties and methods show up in a drop down box.

But not for Word.  Any ideas?

As far as printing to the default printer, that's not gonna work.  I need it to open the Print To dialog box so they can choose a printer.
0
 
David LeeCommented:
You need to add a reference to Word in your Outlook project.  To do that

1.  Click Tools and select References.
2.  Scroll down through the list of available references until you find "Microsoft Word 12.0 Object Library".
3.  Check the box next to that entry.
4.  Click OK

Now create objects of the appropriate type.  For example

  Dim wrdDoc as Word.Document

Once that's done you will see the methods and properties associated with a Word document when you type the period after the object.

I don't remember off-hand about displaying the Print To dialog.  I assume it's possible, but don't remember the command if it is.
0
 
NLXAuthor Commented:
Thanks.  I selected Word 12 Object Model in References.

but I still can't get it to work.  I have some experience with VBA, but its been years and years. I was hoping if I could see the properties and methods to help me out.

I'm remembering now why I try to stay away from VBA, I know what I want to do, spend hours and hours reading help files and obscure references...then ultimately I'm no further along than when I started.  haha

Below is my code, maybe you code take a look and help me out.  I'd like the users to be able to print out to a user selected printer with as little keystrokes as possible.   As you can see I'm using your Category Import/Export code as well.  Good stuff.

On another note, the code craps out when a contact isn't selected.  Any idea why this is?  I see your code to handle this situation, but the debugger opens with a Run Time Error "Array index out of Bounds"

Dim wrdSelection As Object
Const wdFindContinue = 1
Const wdReplaceAll = 2

Sub MergeFromContact(strTemplate As String)
    Dim objTemp As Object, _
        olkContact As Outlook.ContactItem, _
        strMacroName As String, _
        wrdApp As Object, _
        wrdDoc As Object, _
        wrdRange As Object
   
    'General preparation
    strMacroName = "Merge From Contact"
   
    'Check to see that we have a contact selected
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set objTemp = Application.ActiveExplorer.Selection(1)
        Case "Inspector"
            Set objTemp = Application.ActiveInspector.CurrentItem
        Case Else
            MsgBox "You must have a contact open or selected to use this macro.", vbCritical + vbOKOnly, strMacroName
            bolError = True
    End Select
    If objTemp.Class = olContact Then
        Set olkContact = objTemp
    Else
        MsgBox "A contact was not selected.  Operation aborted.", vbInformation + vbOKOnly, strMacroName
        bolError = True
    End If
    If Not bolError Then
   
        'Prep the Word document
        Set wrdApp = CreateObject("Word.Application")
        Set wrdDoc = wrdApp.Documents.Add(strTemplate)
        Set wrdRange = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)
        wrdRange.Select
        Set wrdSelection = wrdApp.Selection


        'Find and replace the replaceable text
        With olkContact
    
            SearchAndReplace "<<BUSINESSADDRESS>>", Replace(.BusinessAddress, vbCrLf, vbCr)
            SearchAndReplace "<<BUSINESSFAXNUMBER>>", .BusinessFaxNumber
            SearchAndReplace "<<BUSINESSTELEPHONENUMBER>>", .BusinessTelephoneNumber
            SearchAndReplace "<<COMPANYNAME>>", .CompanyName
            SearchAndReplace "<<FIRSTNAME>>", .FirstName
            SearchAndReplace "<<FULLNAME>>", .FullName
            SearchAndReplace "<<HOMEADDRESS>>", Replace(.HomeAddress, vbCrLf, vbCr)
            SearchAndReplace "<<HOMEFAXNUMBER>>", .HomeFaxNumber
            SearchAndReplace "<<HOMETELEPHONENUMBER>>", .HomeTelephoneNumber
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<LASTNAME>>", .LastName
            SearchAndReplace "<<MAILINGADDRESS>>", Replace(.MailingAddress, vbCrLf, vbCr)
            SearchAndReplace "<<MOBILETELEPHONENUMBER>>", .MobileTelephoneNumber
            SearchAndReplace "<<PRIMARYTELEPHONENUMBER>>", .PrimaryTelephoneNumber
            SearchAndReplace "<<SPOUSE>>", .Spouse
            SearchAndReplace "<<TITLE>>", .Title
            SearchAndReplace "<<CATEGORY>>", .Categories
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<TODAY>>", Date
          
        End With
   
        'Display the document
        wrdApp.Visible = True
        wrdApp.ActiveDocument.PrintPreview
 '       wrdDoc.PrintOut False
 
'        wrdApp.Close False
'        wrdDoc.Close False
 
        

       
    End If


    'Clean up
    Set olkContact = Nothing
    Set objTemp = Nothing
    Set wrdSelection = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub
Sub SearchAndReplace(strFind As String, strReplace As String)
    With wrdSelection.Find
        .Text = strFind
        .Replacement.Text = strReplace
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

    Sub Ref_Print()
        MergeFromContact "X:\IT\Outlook\FHA Referral Template.dotx"
    End Sub

Sub CategoriesExport()
    Dim objCatProcessor As New CategoryProcessor
    With objCatProcessor

'        .Export InputBox("Enter the name of the file, including the path, you want to export to.", "Get Export Filename")
        .Export
    End With
    Set objCatProcessor = Nothing
End Sub
 
Sub CategoriesImport()
    Dim objCatProcessor As New CategoryProcessor
    With objCatProcessor
' open text box
'        .Import InputBox("Enter the name of the file, including the path, you want to import from.", "Get Import Filename")
        
        .Import
    End With
    Set objCatProcessor = Nothing
End Sub

Open in new window



 
0
 
David LeeCommented:
You have to change the declarations to see the properties and methods.  Right now the objects are all declared as type Object (e.g. wrdApp As Object).  They have to be declared as being of the type of object they actually are (e.g. wrdApp As Word.Application) for the VB editor to be able to show the properties and methods.  When developing in VBA it's a good practice to type objects while developing and testing and then change them to type Object when deploying.  The reason for this is that errors would occur if the person you've shared the code with doesn't have the same references set.

I expect the code was dying because nothing was selected.  I've modified it to test for that too.

Please replace the subroutine MergeFromContact with the version below.  It adds the correct object declarations for the Word objects and adds the check to see if something is selected.



Sub MergeFromContact(strTemplate As String)
    Dim objTemp As Object, _
        olkContact As Outlook.ContactItem, _
        strMacroName As String, _
        wrdApp As Word.Application, _
        wrdDoc As Word.Document, _
        wrdRange As Word.Range
   
    'General preparation
    strMacroName = "Merge From Contact"
   
    'Check to see that we have a contact selected
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            If Application.ActiveExplorer.Selection.Count >= 1 Then
                Set objTemp = Application.ActiveExplorer.Selection(1)
            Else
                MsgBox "You must have a contact open or selected to use this macro.", vbCritical + vbOKOnly, strMacroName
                bolError = True
            End If
        Case "Inspector"
            Set objTemp = Application.ActiveInspector.CurrentItem
        Case Else
            MsgBox "You must have a contact open or selected to use this macro.", vbCritical + vbOKOnly, strMacroName
            bolError = True
    End Select
    If objTemp.Class = olContact Then
        Set olkContact = objTemp
    Else
        MsgBox "A contact was not selected.  Operation aborted.", vbInformation + vbOKOnly, strMacroName
        bolError = True
    End If
    If Not bolError Then
   
        'Prep the Word document
        Set wrdApp = CreateObject("Word.Application")
        Set wrdDoc = wrdApp.Documents.Add(strTemplate)
        Set wrdRange = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)
        wrdRange.Select
        Set wrdSelection = wrdApp.Selection


        'Find and replace the replaceable text
        With olkContact
    
            SearchAndReplace "<<BUSINESSADDRESS>>", Replace(.BusinessAddress, vbCrLf, vbCr)
            SearchAndReplace "<<BUSINESSFAXNUMBER>>", .BusinessFaxNumber
            SearchAndReplace "<<BUSINESSTELEPHONENUMBER>>", .BusinessTelephoneNumber
            SearchAndReplace "<<COMPANYNAME>>", .CompanyName
            SearchAndReplace "<<FIRSTNAME>>", .FirstName
            SearchAndReplace "<<FULLNAME>>", .FullName
            SearchAndReplace "<<HOMEADDRESS>>", Replace(.HomeAddress, vbCrLf, vbCr)
            SearchAndReplace "<<HOMEFAXNUMBER>>", .HomeFaxNumber
            SearchAndReplace "<<HOMETELEPHONENUMBER>>", .HomeTelephoneNumber
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<LASTNAME>>", .LastName
            SearchAndReplace "<<MAILINGADDRESS>>", Replace(.MailingAddress, vbCrLf, vbCr)
            SearchAndReplace "<<MOBILETELEPHONENUMBER>>", .MobileTelephoneNumber
            SearchAndReplace "<<PRIMARYTELEPHONENUMBER>>", .PrimaryTelephoneNumber
            SearchAndReplace "<<SPOUSE>>", .Spouse
            SearchAndReplace "<<TITLE>>", .Title
            SearchAndReplace "<<CATEGORY>>", .Categories
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<TODAY>>", Date
          
        End With
   
        'Display the document
        wrdApp.Visible = True
        wrdApp.ActiveDocument.PrintPreview
 '       wrdDoc.PrintOut False
 
'        wrdApp.Close False
'        wrdDoc.Close False
 
        

       
    End If


    'Clean up
    Set olkContact = Nothing
    Set objTemp = Nothing
    Set wrdSelection = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

Open in new window

0
 
NLXAuthor Commented:
Awesome thanks.  Replaced the subroutine MergeFromContact with code above.

It still craps out when a contact is not selected, only this time AFTER the "You must have a contact open or selected to use this macro" message box.

Screen shot attached with a break on the line that throwing the error.
 error
0
 
David LeeCommented:
Why are you running the macro without selecting a contact?
0
 
NLXAuthor Commented:
Not me man.  The users.  They do strange stuff and when they do it, instead of a nice Message Box that says please select a contact, they get the debugger and then they're all screwed up.

They don't know to even close the Visual Basic editor, then they try to go back to Outlook and run the macro again.....

Just trying to make the macro a little more rugged, but otherwise it works GREAT!
0
 
David LeeCommented:
Got it.  I thought you were still testing, determining if it fulfilled your requirements.  Didn't realize it was in use.

Replace the MergeFromContact subroutine with the version below.  I added an additional test that should eliminate the problem.
Dim wrdSelection As Object
Const wdFindContinue = 1
Const wdReplaceAll = 2

Sub MergeFromContact(strTemplate As String)
    Dim objTemp As Object, _
        olkContact As Outlook.ContactItem, _
        strMacroName As String, _
        wrdApp As Object, _
        wrdDoc As Object, _
        wrdRange As Object, _
        bolError As Boolean
   
    'General preparation
    strMacroName = "Merge From Contact"
   
    'Check to see that we have a contact selected
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set objTemp = Application.ActiveExplorer.Selection(1)
        Case "Inspector"
            Set objTemp = Application.ActiveInspector.CurrentItem
        Case Else
            MsgBox "You must have a contact open or selected to use this macro.", vbCritical + vbOKOnly, strMacroName
            bolError = True
    End Select
    If Not bolError Then
        If objTemp.Class = olContact Then
            Set olkContact = objTemp
        Else
            MsgBox "A contact was not selected.  Operation aborted.", vbInformation + vbOKOnly, strMacroName
            bolError = True
        End If
    End If
    If Not bolError Then
   
        'Prep the Word document
        Set wrdApp = CreateObject("Word.Application")
        Set wrdDoc = wrdApp.Documents.Add(strTemplate)
        Set wrdRange = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)
        wrdRange.Select
        Set wrdSelection = wrdApp.Selection


        'Find and replace the replaceable text
        With olkContact
    
            SearchAndReplace "<<BUSINESSADDRESS>>", Replace(.BusinessAddress, vbCrLf, vbCr)
            SearchAndReplace "<<BUSINESSFAXNUMBER>>", .BusinessFaxNumber
            SearchAndReplace "<<BUSINESSTELEPHONENUMBER>>", .BusinessTelephoneNumber
            SearchAndReplace "<<COMPANYNAME>>", .CompanyName
            SearchAndReplace "<<FIRSTNAME>>", .FirstName
            SearchAndReplace "<<FULLNAME>>", .FullName
            SearchAndReplace "<<HOMEADDRESS>>", Replace(.HomeAddress, vbCrLf, vbCr)
            SearchAndReplace "<<HOMEFAXNUMBER>>", .HomeFaxNumber
            SearchAndReplace "<<HOMETELEPHONENUMBER>>", .HomeTelephoneNumber
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<LASTNAME>>", .LastName
            SearchAndReplace "<<MAILINGADDRESS>>", Replace(.MailingAddress, vbCrLf, vbCr)
            SearchAndReplace "<<MOBILETELEPHONENUMBER>>", .MobileTelephoneNumber
            SearchAndReplace "<<PRIMARYTELEPHONENUMBER>>", .PrimaryTelephoneNumber
            SearchAndReplace "<<SPOUSE>>", .Spouse
            SearchAndReplace "<<TITLE>>", .Title
            SearchAndReplace "<<CATEGORY>>", .Categories
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<TODAY>>", Date
          
        End With
   
        'Display the document
        wrdApp.Visible = True
        wrdApp.ActiveDocument.PrintPreview
 '       wrdDoc.PrintOut False
 
'        wrdApp.Close False
'        wrdDoc.Close False
 
        

       
    End If


    'Clean up
    Set olkContact = Nothing
    Set objTemp = Nothing
    Set wrdSelection = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

Open in new window

0
 
NLXAuthor Commented:
Not fully in use until I get it stabilized.   Only 2 users are using it currently besides me and they keep breaking it.

using the code above I get the following error when a contact is not selected.



 run time error
0
 
David LeeCommented:
Replace with the version below.
Dim wrdSelection As Object
Const wdFindContinue = 1
Const wdReplaceAll = 2

Sub MergeFromContact(strTemplate As String)
    Dim objTemp As Object, _
        olkContact As Outlook.ContactItem, _
        strMacroName As String, _
        wrdApp As Object, _
        wrdDoc As Object, _
        wrdRange As Object, _
        bolError As Boolean
   
    'General preparation
    strMacroName = "Merge From Contact"
   
    'Check to see that we have a contact selected
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            If Application.ActiveExplorer.Selection.Count = 1 Then
                Set objTemp = Application.ActiveExplorer.Selection(1)
            Else
                MsgBox "You must have exactly one contact selected.", vbCritical + vbOKOnly, strMacroName
            End If
        Case "Inspector"
            Set objTemp = Application.ActiveInspector.CurrentItem
        Case Else
            MsgBox "You must have a contact open or selected to use this macro.", vbCritical + vbOKOnly, strMacroName
            bolError = True
    End Select
    If Not bolError Then
        If objTemp.Class = olContact Then
            Set olkContact = objTemp
        Else
            MsgBox "A contact was not selected.  Operation aborted.", vbInformation + vbOKOnly, strMacroName
            bolError = True
        End If
    End If
    If Not bolError Then
   
        'Prep the Word document
        Set wrdApp = CreateObject("Word.Application")
        Set wrdDoc = wrdApp.Documents.Add(strTemplate)
        Set wrdRange = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)
        wrdRange.Select
        Set wrdSelection = wrdApp.Selection


        'Find and replace the replaceable text
        With olkContact
    
            SearchAndReplace "<<BUSINESSADDRESS>>", Replace(.BusinessAddress, vbCrLf, vbCr)
            SearchAndReplace "<<BUSINESSFAXNUMBER>>", .BusinessFaxNumber
            SearchAndReplace "<<BUSINESSTELEPHONENUMBER>>", .BusinessTelephoneNumber
            SearchAndReplace "<<COMPANYNAME>>", .CompanyName
            SearchAndReplace "<<FIRSTNAME>>", .FirstName
            SearchAndReplace "<<FULLNAME>>", .FullName
            SearchAndReplace "<<HOMEADDRESS>>", Replace(.HomeAddress, vbCrLf, vbCr)
            SearchAndReplace "<<HOMEFAXNUMBER>>", .HomeFaxNumber
            SearchAndReplace "<<HOMETELEPHONENUMBER>>", .HomeTelephoneNumber
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<LASTNAME>>", .LastName
            SearchAndReplace "<<MAILINGADDRESS>>", Replace(.MailingAddress, vbCrLf, vbCr)
            SearchAndReplace "<<MOBILETELEPHONENUMBER>>", .MobileTelephoneNumber
            SearchAndReplace "<<PRIMARYTELEPHONENUMBER>>", .PrimaryTelephoneNumber
            SearchAndReplace "<<SPOUSE>>", .Spouse
            SearchAndReplace "<<TITLE>>", .Title
            SearchAndReplace "<<CATEGORY>>", .Categories
            SearchAndReplace "<<JOBTITLE>>", .JobTitle
            SearchAndReplace "<<TODAY>>", Date
          
        End With
   
        'Display the document
        wrdApp.Visible = True
        wrdApp.ActiveDocument.PrintPreview
 '       wrdDoc.PrintOut False
 
'        wrdApp.Close False
'        wrdDoc.Close False
 
        

       
    End If


    'Clean up
    Set olkContact = Nothing
    Set objTemp = Nothing
    Set wrdSelection = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

Open in new window

0
 
NLXAuthor Commented:
Same as before, I see the message box "You must have exactly one contact selected" and then it craps out.

 run time error 3
0
 
David LeeCommented:
Ok, I think this version tests for every possible condition including checking to see that the Word document actually exists.
Sub MergeFromContact(strTemplate As String)
    Const MACRO_NAME = "Merge From Contact"
    Dim objFSO As Object, _
        olkContact As Object, _
        strMacroName As String, _
        wrdApp As Object, _
        wrdDoc As Object, _
        wrdRange As Object, _
        strError As String, _
        intCount As Integer
   
    'Initialize Variables'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strError = ""
    
    'Turn off error handling'
    On Error Resume Next
   
    'Get the open or selected item'
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            intCount = Application.ActiveExplorer.Selection.Count
            If Err.Number <> 0 Then
                intCount = 0
            End If
            Select Case intCount
                Case 0
                    strError = "No items were selected.  You must select one item."
                Case 1
                    Set olkContact = Application.ActiveExplorer.Selection(1)
                Case Is > 1
                    strError = "More than one item was selected.  You may only selecte one item."
            End Select
        Case "Inspector"
            Set olkContact = Application.ActiveInspector.CurrentItem
        Case Else
            strError = "You must have a contact open or selected to use this macro."
    End Select
    
    'Main process'
    If strError = "" Then
        If olkContact.Class = olContact Then
            If objFSO.FileExists(strTemplate) Then
                'Prep the Word document'
                Set wrdApp = CreateObject("Word.Application")
                If TypeName(wrdApp) = "Nothing" Then
                    MsgBox "Word failed to open.", vbCritical + vbOKOnly, MACRO_NAME
                Else
                    Set wrdDoc = wrdApp.Documents.Add(strTemplate)
                    Set wrdRange = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)
                    wrdRange.Select
                    Set wrdSelection = wrdApp.Selection
                    'Find and replace the replaceable text'
                    With olkContact
                        SearchAndReplace "<<BUSINESSADDRESS>>", Replace(.BusinessAddress, vbCrLf, vbCr)
                        SearchAndReplace "<<BUSINESSFAXNUMBER>>", .BusinessFaxNumber
                        SearchAndReplace "<<BUSINESSTELEPHONENUMBER>>", .BusinessTelephoneNumber
                        SearchAndReplace "<<COMPANYNAME>>", .CompanyName
                        SearchAndReplace "<<FIRSTNAME>>", .FirstName
                        SearchAndReplace "<<FULLNAME>>", .FullName
                        SearchAndReplace "<<HOMEADDRESS>>", Replace(.HomeAddress, vbCrLf, vbCr)
                        SearchAndReplace "<<HOMEFAXNUMBER>>", .HomeFaxNumber
                        SearchAndReplace "<<HOMETELEPHONENUMBER>>", .HomeTelephoneNumber
                        SearchAndReplace "<<JOBTITLE>>", .JobTitle
                        SearchAndReplace "<<LASTNAME>>", .LastName
                        SearchAndReplace "<<MAILINGADDRESS>>", Replace(.MailingAddress, vbCrLf, vbCr)
                        SearchAndReplace "<<MOBILETELEPHONENUMBER>>", .MobileTelephoneNumber
                        SearchAndReplace "<<PRIMARYTELEPHONENUMBER>>", .PrimaryTelephoneNumber
                        SearchAndReplace "<<SPOUSE>>", .Spouse
                        SearchAndReplace "<<TITLE>>", .Title
                        SearchAndReplace "<<CATEGORY>>", .Categories
                        SearchAndReplace "<<JOBTITLE>>", .JobTitle
                        SearchAndReplace "<<TODAY>>", Date
                    End With
                    'Display the document'
                    wrdApp.Visible = True
                    wrdApp.ActiveDocument.PrintPreview
                    'wrdDoc.PrintOut False'
                    'wrdApp.Close False'
                    'wrdDoc.Close False'
                End If
            Else
                MsgBox "The document template '" & strTemplate & "' does not exist.", vbCritical + vbOKOnly, MACRO_NAME
            End If
        Else
            MsgBox "The item selected is not a contact.  You must have a contact open or selected to use this macro.", vbCritical + vbOKOnly, MACRO_NAME
        End If
    Else
        MsgBox strError, vbCritical + vbOKOnly, MACRO_NAME
    End If
            
    'Clean up'
    Set objFSO = Nothing
    Set olkContact = Nothing
    Set objTemp = Nothing
    Set wrdSelection = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

Open in new window

0
 
NLXAuthor Commented:
OK Cool

So far this has not crapped out when a contact is not selected....however

It doesn't populate the Word Document.  I don't think The Search and Replace routine is getting passed anything from the contact that is selected,  Hope that makes sense.  
0
 
David LeeCommented:
Does the Word doc have some of the replaceable text in it?
0
 
NLXAuthor Commented:
Yes it has all the replaceable text in it.  Looks like the original file, nothing has been changed.
0
 
David LeeCommented:
Are you sure you have all the code?  Compare what you have with the original question.  It works perfectly for me.
0
 
NLXAuthor Commented:
oops...sorry man.  Missed a Dim statement.

Works great!!  Thank you for all your help.
0
 
David LeeCommented:
You're welcome!  Glad I could help out.
0
 
NLXAuthor Commented:
BlueDevilFan:
One last thing....after the code makes the Word document visible, how do I use VBA to unselect everything?
0
 
David LeeCommented:
Are you saying that text in the document is selected once the code has finished?  If so, then I don't understand why.  When I run the code here nothing is selected when it's finished.
0
 
NLXAuthor Commented:
Yeah that's what I'm saying.  Once the code has finished the newly created Word document has all the text selected.
0
 
David LeeCommented:
Try adding this

    wrdApp.Selection.moveStart Unit:=6

just before line 76
0
 
NLXAuthor Commented:
That works great.  Thanks again.
0
 
David LeeCommented:
You're welcome.
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 14
  • 13
Tackle projects and never again get stuck behind a technical roadblock.
Join Now