Need to send mail to filtered people

[veer81]

Hi All,

I'm going to explain this as best as I can and hope I make sense.

I have an excel workbook which is a result of a sports survey I conducted. It basically shows who likes which sport, what level they're at, preferred time of play, etc, and their email address.

A colleague has created a type of form (using formulas, not VBA) wherein you select your criteria (Sport, Gender, Level etc) and it displays the matching names.

What I'd like is to be able to select, via a check box or similar, 1 or more names from the list of results for that sport, click a button, and their addresses automatically open in a new Outlook mail window for the person to send a mail to those people.

This is an internal work thing, so everyone uses Outlook.

Hope that makes sense, and I really appreciate any help you can offer.
Note that I'm not an excel whiz at all, so would really need help from scratch.

Thanks!

 

[VishMishra]

Hi,

Try the below code.

Here are the points:

As per the below code, Email IDs are there in E column and 2nd row onwards. After filtering, whatever list is appearing, below code will take all the email IDs and put it in To List of the email and send it to all.

Also, whatever list of email ids are visible after applying filter, it takes only those email IDs, for which in the Column B, it is marked as "Y".

Sub SendEmailUsingOutlook()
Dim OlApp As New Outlook.Application
Dim myNameSp As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myExplorer As Outlook.Explorer
Dim NewMail As Outlook.MailItem
Dim OutOpen As Boolean
Dim ToEmail As String
Dim i As Integer
ToEmail = ""
    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set myExplorer = OlApp.ActiveExplorer
    If TypeName(myExplorer) = "Nothing" Then
        OutOpen = False
        Set myNameSp = OlApp.GetNamespace("MAPI")
        Set myInbox = myNameSp.GetDefaultFolder(olFolderInbox)
        Set myExplorer = myInbox.GetExplorer
    End If

'çreate the To list
i = 2
While Worksheets("Sheet1").Cells(i, 6).Value <> ""

If Rows(i).Hidden = False And UCase(Worksheets("Sheet1").Cells(i, 2).Value) = "Y" Then
ToEmail = ToEmail & "; " & Trim(Worksheets("Sheet1").Cells(i, 6).Value)
End If
i = i + 1
Wend


    ' Create a new mail message item.
    Set NewMail = OlApp.CreateItem(olMailItem)
    With NewMail
        '.Display ' You don't have to show the e-mail to send it
        .Display
        .Subject = "Your Subject here"
        .To = Right(ToEmail, Len(ToEmail) - 1)
        .Body = "Your message"
    End With

    NewMail.Send
    If Not OutOpen Then OlApp.Quit

    'Release memory.
    Set OlApp = Nothing
    Set myNameSp = Nothing
    Set myInbox = Nothing
    Set myExplorer = Nothing
    Set NewMail = Nothing

End Sub

 

[veer81]

Hi Vish,

Thanks so much. Excuse my stupidity but I can't figure out how to edit the column & row.

FYI, the email addresses will appear in column Q, from the 6th row onwards.
Also, sometimes I'll have 1 record, or 3, or maybe 60, so accordingly I'd like to be able to select whichever I want. Know what I mean?

Also, the worksheet where the results appear is called Selection

Thanks again!

 

[VishMishra]

No issues

Hopefully below code will help...

For Only those email IDs will be picked up for which you have entered "Y" in column B. Is it fine?

Sub SendEmailUsingOutlook()
Dim OlApp As New Outlook.Application
Dim myNameSp As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myExplorer As Outlook.Explorer
Dim NewMail As Outlook.MailItem
Dim OutOpen As Boolean
Dim ToEmail As String
Dim i As Integer
ToEmail = ""
    ' Check to see if there's an explorer window open
    ' If not then open up a new one
    OutOpen = True
    Set myExplorer = OlApp.ActiveExplorer
    If TypeName(myExplorer) = "Nothing" Then
        OutOpen = False
        Set myNameSp = OlApp.GetNamespace("MAPI")
        Set myInbox = myNameSp.GetDefaultFolder(olFolderInbox)
        Set myExplorer = myInbox.GetExplorer
    End If

'çreate the To list
i = 6
While Worksheets("Selection").Cells(i, 17).Value <> ""

If Rows(i).Hidden = False And UCase(Worksheets("Selection").Cells(i, 2).Value) = "Y" Then
ToEmail = ToEmail & "; " & Trim(Worksheets("Selection").Cells(i, 17).Value)
End If
i = i + 1
Wend


    ' Create a new mail message item.
    Set NewMail = OlApp.CreateItem(olMailItem)
    With NewMail
        '.Display ' You don't have to show the e-mail to send it
        .Display
        .Subject = "Your Subject here"
        .To = Right(ToEmail, Len(ToEmail) - 1)
        .Body = "Your message"
    End With

    NewMail.Send
    If Not OutOpen Then OlApp.Quit

    'Release memory.
    Set OlApp = Nothing
    Set myNameSp = Nothing
    Set myInbox = Nothing
    Set myExplorer = Nothing
    Set NewMail = Nothing

End Sub

http://www.learnexcelmacro.com/2011/12/how-to-send-email-by-excel-macro-from-outlook/

 

[veer81]

Hi again,

Sorry, still don't get it. I've attached an image of the sheet. I had to change the names and email addresses since I don't want to be fired.

Hopefully that will help make things clearer.

So I'd like to select Q7, Q9, Q11 for example, and then click a button to mail them all.

THANKS!

Okay, just found out I can't attach a file. Could I mail it to you?