Excel VBA - Send outlook email

1
votes


In Cell A I have names, e.g. John Smith
In Cell B I have a criteria - Due/ Not Due.
I need to somehow modify the below code to do the following:
Generate emails from cell A, in the format [email protected] and Then send out a reminder email, but only to unique emails in one email. So far this is what I have:

Sub SendEmail()

    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    Dim Msg As String

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Loop through the rows
    For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
        If cell.Value Like "*@*" And _
           LCase(Cells(cell.Row, "B").Value) = "Due" _
            Then
            EmailAddr = EmailAddr & ";" & cell.Value
        End If
    Next

    Msg = "Please review the following message."
    Subj = "This is the Subject Field"

    'Create Mail Item and view before sending
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Display
    End With

End Sub

I can't get much further, unfortunately. Can anyone help me please?

3
vbaexcelemailoutlook
besides the issue raised by @MacroMan, your code looks good. What exactly is the problem. You have not stated what is not working for you. – Scott Holtzman
In column A I have a list of Names and Surnames, I don't know how to convert the loop (i.e. John Smith to [email protected]) and send out in one email. Furthermore, I somehow need to filter out and send only to unique emails, as sometimes the person repeats... – warfo09
is the company name the same each time? or is that defined in another cell or somewhere else? – Scott Holtzman
It's the same one. Ok, Macro Man already replied in terms of converting -- = LCase$(Replace(cell.value, " ", ".") & "@company.com") How do I go about the unique emails ? – warfo09
see my answer which incorporates all issues – Scott Holtzman

3 Answers

1
votes
LCase(Cells(cell.Row, "B").Value) = "Due"

This will always return false, because LCase() converts the whole string to Lowercase and you're comparing it to "Due" which has an upper case "D"

Either, change your comparison string to "due":

LCase(Cells(cell.Row, "B").Value) = "due"

Or (not recommended, but showing for education purpose) change your string operation to proper case:

StrConv(Cells(cell.Row, "B").Value, vbProperCase) = "Due"
1
votes

Fully scoped answer here. I put comments in the areas of the existing code that I added / edited.

Sub SendEmail()

    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    Dim Msg As String

    'Create Outlook object
    Set OutlookApp = New Outlook.Application

    'Loop through the rows
    For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
        If cell.Value Like "*@*" And _
           LCase(Cells(cell.Row, "B").Value) = "due" Then
            'first build email address
            EmailAddr = LCase$(Replace(cell.Value, " ", ".")) & "@company.com"
            'then check if it is in Recipient List build, if not, add it, otherwise ignore
            If InStr(1, Recipient, EmailAddr) = 0 Then Recipient = Recipient & ";" & EmailAddr
        End If
    Next

    Recipient = Mid(Recipient, 2) 'get rid of leaing ";"

    Msg = "Please review the following message."
    Subj = "This is the Subject Field"

    'Create Mail Item and view before sending
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = Recipient 'full recipient list
        .Subject = Subj
        .Body = Msg
        .Display
    End With

End Sub
0
votes

Maybe like this?

Sub SendEmail()

Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String

'Create Outlook object
Set OutlookApp = New Outlook.Application

'Loop through the rows
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
    If cell.Value Like "*@*" And _
       LCase(Cells(cell.Row, "B").Value) = "due" _
        Then
        EmailAddr = cell.Value
    End If


    Msg = "Please review the following message."
    Subj = "This is the Subject Field"

    'Create Mail Item and view before sending
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Display
    End With

    EmailAddr = ""

Next

End Sub

What I did was: Include the creation of the mailitem into the loop, and reset the variable EmailAddr after the mail is displayed

Also, I updated the code with Macro Man his suggestion.