Mail Merge Email with Attachments (VBA)

[Snaps]

I'm trying to create an email mail merge that will personalize the emails to each individual on my list, at the same time attach a document.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I can currently do everything with a simple mail merge aside from the file attachment. I've read that a VBA macro can accomplish this but my VBA skills are very limited (editing code is semi tough without an example).<o></o>
<o></o>
I have the Word document created for the email with a space for the merge to personalize to the individual based on Column A.<o></o>
<o></o>
Column A - Preferred Name (the name used at the heading of my Word document for personalization)<o></o>
Column B - Email Address<o></o>
Column C - Attachment (the File path to the document)<o></o>
<o></o>
Any help with the VBA coding and the process from where I'm at to successfully sending an attachment with the Word document would be a big help.<o></o>
<o></o>
Also need to add a Subject line to the email so not sure how that works once the VBA is set.<o></o>
<o></o>
Thank you for any help.<o></o>

 

[Snaps]

That looks perfect!

You have been a huge help in creating this VBA that does everything I could hope for. Thank you so much.

Last last question which could become problematic:
When I open the email that I test sent myself I get an Attention Alert that states,

"One or more ActiveX controls could not be displayed because either:
1) Your current security settings prohibit running ActiveX Controls on this page or
2) You have blocked a publisher of one of the controls.

As a result, the page might not display correctly."

If the people I send these emails to get this alert as well they may dismiss it as junk.

Is there a way of sending the emails to avoid this concern?

 

[AlphaFrog]

Do you really need to add an ActiveX control to your email body? If yes, I don't know a way around that message. That's a security setting you wouldn't want your recipients to have to change.

I recommend you don't use any ActiveX controls in your email body.

 

[Snaps]

Sounds good.

That was my first test using a possible message that could be sent out. I'll look at some other examples and simply weed out those that create the alert.

Thanks again ray:

 

[Snaps]

The Final Code - Has problems sending pictures in the body of the email but aside from that works like a dream. The body of the email should be saved as a .htm so the formatting of the texts comes across. The Columns of the workbook are still all the same.

Sub Send_Files()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range, FileCell As Range, rng As Range
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set sh = Sheets("Sheet1")
    Set OutApp = CreateObject("Outlook.Application")
    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        'Enter the file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("E1:Z1")
        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
 
            'Need to include Your_Name_Here in the body of the text to personalize
 
            strbody = GetBoiler(cell.Offset(0, 2))
            strbody = Replace(strbody, "Your_Name_Here", cell.Offset(0, -1).Value, Compare:=vbTextCompare)
 
 
            With OutMail
                .To = cell.Value
                .Subject = cell.Offset(0, 1)
                .HTMLBody = strbody
 
                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell
 
                .Send  'Or use Display
            End With
            Set OutMail = Nothing
        End If
    Next cell
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

 

[Snaps]

I'm not sure what has happened but I'm now receiving:

Run-time error '53' - File not found

On

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

Nothing has changed in my code but the macro is no longer working because of this.

Any help would be appreciated.

 

[AlphaFrog]

sFile is the file path and file name from cell.Offset(0, 2). That file can't be found.

Check the path (spelling, spaces, etc.) and Name within the cell to make sure the file can be found. It's easy for someone to accidentally change something in the path or name. Make sure you didn't add a trailing space at the end or something like that.

 

[Snaps]

It's part of this function:

Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

As far as I know it was never linked to anything. It added the .htm document I had the file path to in Coulmn D to the body of the email.

Thank you again for your help.

 

[AlphaFrog]

I didn't understand what you just said?

 

[Snaps]

The part of the macro that is giving me the error message is from that function I have listed above. I got the function from Ron de Bruin's site that you gave me initially and just placed it into the macro.

It's purpose is to take the file path I have in column D from my spreadsheet and it insert it as the body of the email. I never changed anything in the function from what I had recieved from the site to make it work.

It just seems that over the weekend without changing anything in the file the macro is now giving me the error 53 message.

I'm just not sure how to repair it to make it work again.

I hope that clears up my previous post.

 

[AlphaFrog]

I understand what the function does. I was previously stating that the the file name or path from column D has changed somehow. Double and triple check that each filename and path in column D is valid. One could have been accidentally changed.

As a test, add this line to the code to see what file name the function is using each time it is called...

Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
[COLOR="Red"]MsgBox sFile[/COLOR]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function