Mail Merge with correct format

amentinho · #1 03-10-2015, 02:16 AM

Hi all,

I'm new to Word Vba and I'm trying to do a Macro to send various mails with attachment by Merge Mail tool help. I copy some indications from various webs but I cannot find a solution to my problem

The macro is working, but it send the mail without format. I'd like to send the mail in the same format as it appear in word.

I'm using this code

Code:

Sub emailmergewithattachments()

Dim Source As Document, Maillist As Document, TempDoc As Document
Dim Datarange As Range
Dim i As Long, j As Long
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mysubject As String, message As String, title As String
Set Source = ActiveDocument

On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If

With Dialogs(wdDialogFileOpen)
    .Show
End With
Set Maillist = ActiveDocument

message = "Enter the subject to be used for each email message."
title = " Email Subject Input"

mysubject = InputBox(message, title)

For j = 1 To Source.Sections.Count - 1
    Set oItem = oOutlookApp.CreateItem(olMailItem)
    With oItem
        .Subject = mysubject
        .Body = Source.Sections(j).Range.Text
        Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
        Datarange.End = Datarange.End - 1
        .To = Datarange
        .BCC= "amentinho@example.com"
        For i = 2 To Maillist.Tables(1).Columns.Count
            Set Datarange = Maillist.Tables(1).Cell(j, i).Range
            Datarange.End = Datarange.End - 1
            .Attachments.Add Trim(Datarange.Text), olByValue, 1
        Next i
        .Send
    End With
    Set oItem = Nothing
Next j
Maillist.Close wdDoNotSaveChanges

If bStarted Then
    oOutlookApp.Quit
End If
MsgBox Source.Sections.Count - 1 & " messages have been sent."

Set oOutlookApp = Nothing
End Sub

How can I use this macro manteining the original word file format?

Any help would be really appreciate.

Thanks

gmayor · #2 03-10-2015, 03:56 AM

If by 'send it in the same format as it appears in Word', you mean the message body should have the same format, then you are destined to be disappointed. Word document format and html e-mail format are entirely different from one another. You can get it close if you start by formatting the document in Word's web view, but an exact facsimile is unrealistic.

If format is important then mail it as an attachment in PDF format. http://www.gmayor.com/ManyToOne.htm in one to one mode will achieve either a formatted merge to e-mail body or as an attachment (with or without a personalised covering message). The only proviso is that the merge data must be an Excel worksheet (with the e-mail addresses in the records). The BCC is also possible.

Having said that, it is possible to improve on your macro, but there are some anomalies e.g. you have both the Source Document and the Maillist Document set as the activedocument, which seems odd, given that Source is presumably the product of a mail merge to a new document. You will have to explain that one.

Rather than just use the .Body of the message, you need to use the Outlook Inspector to enable you to edit the message body e.g. something along the lines of

Code:

For j = 1 To Source.Sections.Count - 1
        Set oItem = oOutlookApp.CreateItem(olMailItem)
        With oItem
            .BodyFormat = 2
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            'If you don't want the default signature, remove the next line
            oRng.Collapse 1
            .Display 'this must not be removed.
            .Subject = mysubject
            oRng.FormattedText = Source.Sections(j).Range.FormattedText
            Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
            Datarange.End = Datarange.End - 1
            .to = Datarange
            .BCC = "amentinho@example.com"
            For i = 2 To Maillist.Tables(1).Columns.Count
                Set Datarange = Maillist.Tables(1).Cell(j, i).Range
                Datarange.End = Datarange.End - 1
                .Attachments.Add Trim(Datarange.Text), olByValue, 1
            Next i
            .Send
        End With
        Set oItem = Nothing
    Next j

is probably not far off (olInsp, wdDoc and oRng are each declared as Object) but without the document to test against it is only a guide.

amentinho · #3 03-10-2015, 05:30 AM

Hello, thanks for the reply.

I tried your code, executing it step by step, it send the mail correctly but without any message. Anymore it sends the mail at the line

Code:

oRng.FormattedText = Source.Sections(j).Range.FormattedText

The source active document is the body message that I have to send. After that the code will active other word document that contains information about mail destination and attachment directory.

I don't want an exact format word format in the mail, but I need to enclose bold formatting, colour formatting and some image.

If I try the mail merge without attachment (from word utilities) it gives me back a good formatted mail. I'd like to obtain a format like this.. Could it be possible?

Thanks a lot

gmayor · #4 03-10-2015, 05:45 AM

Try replacing that line with

Code:

Source.Sections(j).Range.Copy
oRng.Paste

If that doesn't work, try merging the document again with http://www.gmayor.com/ManyToOne.htm

amentinho · #5 03-10-2015, 06:13 AM

It functions perfectly!!!

Regards

amentinho · #6 05-13-2015, 04:40 AM

Hello all,

I reopen this post because the macro send first mail correctly but after that it sends mails without any format.. How could it be resolved?

gmayor · #7 05-13-2015, 10:33 PM

If you use the add-in as I suggested, all the messages will be sent using the same document to provide the format.

Without the actual document to see what you are doing it is difficult to make further suggestions.

MSCCTV · #8 10-10-2015, 07:01 PM

Quote:

Originally Posted by amentinho

Hello all,

I reopen this post because the macro send first mail correctly but after that it sends mails without any format.. How could it be resolved?

my mistake. all my mistake

macropod · #9 10-10-2015, 07:08 PM

Why are you doing that instead of using the code as provided? When adding those lines, did you delete or comment-out the following line?
oRng.FormattedText = Source.Sections(j).Range.FormattedText

MSCCTV · #10 10-10-2015, 07:20 PM

Quote:

Originally Posted by macropod

Why are you doing that instead of using the code as provided? When adding those lines, did you delete or comment-out the following line?
oRng.FormattedText = Source.Sections(j).Range.FormattedText

my mistake. all my mistake

macropod · #11 10-10-2015, 07:45 PM

There is nothing in the code that would cause the text to be duplicated. The only way that would happen is if you duplicated the Paste or didn't comment-out the other line.

PS: Please don't duplicate your posts and, when posting code, use the code tags (inserted by the # symbol on the posting menu) to post formatted code. There is also no need to post code that's exactly the same as in another post in the same thread...

MSCCTV · #12 10-10-2015, 07:56 PM

Quote:

Originally Posted by macropod

There is nothing in the code that would cause the text to be duplicated. The only way that would happen is if you duplicated the Paste or didn't comment-out the other line.

PS: Please don't duplicate your posts and, when posting code, use the code tags (inserted by the # symbol on the posting menu) to post formatted code. There is also no need to post code that's exactly the same as in another post in the same thread...

just my mistake. all my mistake

macropod · #13 10-10-2015, 08:43 PM

Quote:

Originally Posted by MSCCTV

I just use the same Copy/Paste codes provided in this post. Is there anything wrong?

As you would have seen when you posted the code you had copied, all the structure was lost, which makes it much harder to read.

Quote:

I just duplicated all the codes provided here and test. but not yet fully suceed.

As I have already said, twice now, nothing in the code in post #2, even if modified as per the advice in post #4, will result in duplicated content. If you're getting duplicated content in the output, it's either because it's already duplicated in what you're copying from or you're pasting multiple times.

MSCCTV · #14 10-10-2015, 09:01 PM

thank you. problem is solved. Cheers!

macropod · #15 10-10-2015, 09:23 PM

Try running just the following stripped-down code. It should produce a series of new documents - one per Section of your source document, with just one copy of each Section's content per new document.

Code:

Sub emailmergewithattachments()
Dim Source As Document, wdDoc As Document, oRng As Range, j As Long
Set Source = ActiveDocument
For j = 1 To Source.Sections.Count - 1
  Set wdDoc = Documents.Add
  Set oRng = wdDoc.Range
  oRng.Collapse 1
  'oRng.FormattedText = Source.Sections(j).Range.FormattedText
  Source.Sections(j).Range.Copy
  oRng.Paste
Next j
MsgBox Source.Sections.Count - 1 & " messages have been sent."
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Mail Merge Format random 0s	lmoir87	Mail Merge	2	07-31-2014 03:45 AM
Change Mail Merge Date Format from US to UK	Evanaught	Mail Merge	1	09-29-2013 08:02 PM
Issue with date format in mail merge document	walshjod	Mail Merge	4	11-28-2012 04:46 AM
Mail merge will not format date field generated by Excel IF statement	borntorun75	Mail Merge	3	12-16-2011 06:28 AM
Correct Format needed	TonyB	Mail Merge	3	05-03-2011 01:10 AM