Help Programming Email Via Excel Spreadsheet

Hi all,

I am trying to create a macro from a sheet formatted in the following way: (the sheet is a list of products we do not have in stock)

Name        Product        Email                       Send Email
John         Part A          [email protected]       Yes
Mike         Part B          [email protected]         Yes
John         Part C          [email protected]       Yes

What I want to happen when I run the macro is an email is created/sent for each UNIQUE email address with a list of the parts that we have been unable to deliver to them.

So for the example above, the email would read:

Dear John, 

Unfortunately, we have been unable to supply the following products to you today

Part A
Part C

Please call us on 01111111 if you would like to re-order when we fresh stock arrives, 

Regards, 

DEFAULT OUTLOOK SIGNATURE INCLUDED

I have played around with the following, but am struggling with a way to tell excel to compile all shorts with the same email...

Sub Test1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Unfortunately, we have been unable to supply the following products to you today " & _
                        vbNewLine & vbNewLine & _
                        Cells(cell.Row, "A").Value _
                        
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send  'Or use Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Any help with this would be appreciated.

And also what code would include the default signature from my outlook?

Thanks in advance

Hi,

Thanks for the reply. I'm not sure the above would address my problem?

To clarify, the spreadsheet would be 50 lines+, so to use the filter function would take too much time really.

I'm really looking for one Macro that would do all emails if possible?

Hi,

No, I can't get that to work for me. My list may have 30 different emails on, with many of them repeated. I need the macro to create one mail per unique email address, but include the details from all rows associated with that email address...

I apologise for my lack of coding knowledge....

Originally Posted by bakerman2

Or use Dictionary to create unique list and email.

Sub tst()
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        sn = .Cells(1).CurrentRegion.Value
        For i = 2 To UBound(sn)
            x0 = dic.Item(sn(i, 3))
        Next
        For j = 0 To dic.Count - 1
            .Cells(1).CurrentRegion.AutoFilter 3, dic.keys()(j)
            .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Range("A1") 'temp sheet to create htmlRange
            'code to create email
            '....
            Sheets("Sheet2").Cells(1).CurrentRegion.ClearContents 'clear range for next email
        Next
    End With
End Sub

I'm just playing with this one now.....

Hi Bakerman,

The Macro runs, but no emails are generated?

Am I doing something wrong here (been a loong day!)

Sorry, to correct myself there...

It's almost there. Just 2 small points.

1. The macro creates the mails, but how do I get them to send rather than just create them.
2. How would I go about adding my default signature to the emails?

Many thanks for your patience!! It really is appreciated!