troubleshooting Question

Preserve formatting during mail merge using VBA

Avatar of cErasmus
cErasmusFlag for Namibia asked on
Microsoft OfficeMicrosoft ExcelMicrosoft WordVBA
18 Comments3 Solutions745 ViewsLast Modified:
Hi All

I have created a Word document and Excel workbook to do a mail merge. The word document contains bookmarks to indicate where merged fields should be added. All the work from creating the connection to adding the merge fields happens in a macro in the Excel workbook. Everything works fine. The only problem that i'm having is that formatting is not carried over into the Word document form the Excel workbook.  For example in the Excel wb a field might be a currency field with 2 decimal places when it is taken to the word document it does not retain this formatting and instead of $12.30 i end up with 12.3012943. I do not mind so much about the "$" signs as i can easily add this to the Word document the decimal places is the real issue. I have seen that when you add a field manually in a Word document and right click and Edit it there is a check box to Preserve formatting but i cannot find how to this with VBA. I have also tried to record a macro doing this but Word does not allow me to right click while recording. I have added the code i use below.
Sub DoMerge()
Dim appWd As Word.Application
Dim WdDoc As Word.Document
Dim strBookFullName As String
Dim cell As Range
Dim wdFind As Object
strBookFullName = ActiveWorkbook.FullName

Set appWd = CreateObject("Word.Application")
appWd.Visible = True

With appWd
    Set WdDoc = appWd.Documents.Open("C:\Users\Elmo\Documents\Aaron\2nd Project 2017\WorkingOn\VendorRebateClientDoc4March17_2.docx")
    WdDoc.Activate
    WdDoc.MailMerge.OpenDataSource Name:=(strBookFullName), _
    ReadOnly:=True, LinkToSource:=0, AddToRecentFiles:=False, _
    PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
    WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
    Connection:="", SQLStatement:="SELECT * FROM `MergeRange`", SQLStatement1:=""

Set wdFind = appWd.Selection.Find
    'finds text in word doc and replace with merge field
    For Each cell In Range("MergeText")
        
        wdFind.Text = cell.Value
        
        Dim MyDoc As String, txt As String, t As String
        MyDoc = WdDoc.Range.Text
            txt = cell.Offset(0, 1).Value
            t = Replace(MyDoc, txt, "")
            X = (Len(MyDoc) - Len(t)) / Len(txt)
            'ActiveDocument.Bookmarks("Cname").Select
            ActiveDocument.MailMerge.Fields.Add Range:=WdDoc.Bookmarks(cell.Offset(0, 2).Value).Range, Name:=txt
    Next cell
    
End With

End Sub

Thanks in advance
Elmo
ASKER CERTIFIED SOLUTION
GrahamSkan
Retired
Join our community to see this answer!
Unlock 3 Answers and 18 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 3 Answers and 18 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros