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]

Bump

Sorry for the bump but this information would be a huge help for me.

Thank you

 

[AlphaFrog]

Ron de Bruin's site is probably the definitive site for VBA email code with examples and down loads. It gives you step-by-step instruction.

If you need additional help from there, post a specific question back here. Include the version of Excel you have and what email method you are using.

 

[Snaps]

Thank you very much.

I will check that site out and if I come across any more questions I'll be sure to post back here.

But I am using Excel 2003 and the emails are going through Outlook.

 

[Snaps]

This coding does nearing everything I'm after but its very difficult to add text and a signature to the body of the email.

Sub Send_Files()
'Working in 2000-2010
    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("C1:Z1")
        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value
 
                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

Using Microsoft Office Outlook and Excel 2003.
When using the Word email merge I copy my signature and everything into the Word document and its formatted accordingly. The VBA coding does what Word is missing by adding attachments but is missing the formatting of the Word document.

If anyone could help me clarify how to make the body of the message cleaner now I would greatly appreciate it.

 

[Snaps]

I have combined multiple codes from the link provided to me above to do everything I was after. Figured I'd post it here incase others were after something similar.

What you need in the actual excel worksheet:
A = Preferred Name (Dear ____)
B = Email Address
C-Z = Attachment Filepath (C:/....../***.pdf)

Sub Send_Files()
'Working in 2000-2010
    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("C1:Z1")
        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            
            strbody = "Dear " & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
            GetBoiler("The Filepath to the txt file that you want as the body.txt")
            With OutMail
                .To = cell.Value
                .Subject = "The Subject Line"
                .Body = 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

I didn't write the code so I'm taking no credit there. I simply edited a few of them and put them together. I hope this helps someone else in my situation.

Thank you guys

 

[Snaps]

I'm back and need more help. I've edited my macro to make everything more customizable for each individual on my excel list of names and emails.

The problem I'm having now is being able to format the body of my message to anything other than a txt file. I need to be able to include hyperlinks and formating to the body of my message.

Here is what I currently have: (Using Excel 2003 and Outlook 2003)
A- Name
B- Email Address
C- Subject Line
D- The Body of the Email
E-Z- Attachments

Sub Send_Files()
'Working in 2000-2010
    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)
 
            strbody = "Dear " & cell.Offset(0, -1).Value & "," & vbNewLine & vbNewLine & _
            GetBoiler(cell.Offset(0, 2))
 
 
            With OutMail
                .To = cell.Value
                .Subject = cell.Offset(0, 1)
                .Body = 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

Again, any help would be very appreciated.
Thank you

 

[jberwald]

Check out this site:
http://word.mvps.org/faqs/mailmerge/MergeWithAttachments.htm

Hope it helps.

 

[Snaps]

I appreciate the reply but I wasn't able to get past the first Step Into of that code.

Sub emailmergewithattachments()
Dim Source As Document, Maillist As Document, TempDoc As Document

It says, "Compile error: User-defined type not defined"

That's just the first of many errors I get while stepping into it.

 

[AlphaFrog]

Create a "Boiler" file in HTML format. You could use MS-Word to create it with all the formatting and links the way you want and then and save it as an .htm file.

When you are creating the Boiler HTML file, where ever you want to insert the the name from column A, put "Your_Name_Here" without the quotes; e.g.
Dear Your_Name_Here,

Reference that boiler file in column D

Read that boiler file in your Send_Files code with...

            strbody = GetBoiler(cell.Offset(0, 2))
            strbody = Replace(strbody, "Your_Name_Here", cell.Offset(0, -1).Value, Compare:=vbTextCompare)

Apply the HTML code to your email with...

                .HTMLBody = strbody