Mail Merge Macro to E-Mail with Attachments (VBA)

[Christopher_Green]

Hi there, I was looking over the forum's and noticed that you where kind enough to help someone out with a Mail Merge Email with Attachments (</SPAN>VBA</SPAN>) Query and I was wondering if you might be able to provide me with some assistance. I have been on http://www.rondebruin.nl/index.htm</SPAN> and downloaded his Macro to Mail Merge with attachments but my question/request is it possible to update the macro so that it also picks up if I have a CC E-mail address in Column B for example. I know the Macro runs down each row and looks for an E-mail Address in Column A but I also want it to look to see if I have one in Column B, the other more tricky thing is I still want the Macro to run even if Column B does not contain an E-Mail address. I would be really; really grateful for any advice or support you could give me. Thanks in advance. Christopher Green[TABLE="class: grid, width: 500"]
<TBODY>[TR]
[TD]Column A</SPAN>
[/TD]
[TD]To: (E-Mail Address)</SPAN>
[/TD]
[/TR]
[TR]
[TD]Column B</SPAN>
[/TD]
[TD]CC: (E-Mail Address)</SPAN>
[/TD]
[/TR]
[TR]
[TD]Column C</SPAN>
[/TD]
[TD]File Name: (File Path)</SPAN>
[/TD]
[/TR]
</TBODY>[/TABLE]

</SPAN>

 

[Comfy]

MailObject.CC = Cells(row, 2).Value

For a more specific answer please paste the code you are using, making sure to use the code tags.

 

[Christopher_Green]

Hi Comfy,

Thank you for your response, please see below the Macro that I am using, Please also note that the Macro also picks up some information from Sheet 2.

Sub Send_Files()
'Working in Excel 2000-2013
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim 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("A").Cells.SpecialCells(xlCellTypeConstants)
        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("B1:Z1")
        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .SentOnBehalfOfName = ThisWorkbook.Sheets("Sheet2").Range("E2").Value
                .to = cell.Value
                .CC = ""
                .BCC = ""
                .Subject = ThisWorkbook.Sheets("Sheet2").Range("E6").Value
                .Body = ThisWorkbook.Sheets("Sheet2").Range("B8").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
                .display  'Or use Send
            End With
            Set OutMail = Nothing
        End If
    Next cell
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Thanks again.

 

[Comfy]

To add the Email Address in column be you .cc will read:

.CC = Cell.Offset(0,1).Value

 

[Christopher_Green]

Hi Comfy,

That has worked perfectly, Thank you so much.

Who knew it was that Simple!