Exploring how to send emails from excel

[288enzo]

I have a list of emails in column D that I would like to be the To:, and a list of emails in column E that I would like to be cc'd.

The way I see it in my mind working, is if there is an "x" in H4, the macro is ran, then an email will open and D4 will be in the "to" and E4 will be in the "cc". This would continue opening separate emails if multiple "x"s are found in H, always looking for an "x" in the row and using emails from the same row the "x" is found.

That's the first bit. The rest would be using E1 as the subject line, and even better, if there was a way to make the body of the email that which is in Sheet1.

A long list, but this is my first step into emails and excel. Feel free to point me in the right direction if necessary.

Thank you very much.

ABE Roster 11-15 AM.xlsx
	D	E	F	G	H
1		Subject
2	To:	CC:			X = send
3
4	email	email			x
5
6	email	email
7
8	email	email			x
9
10	email	email
11
12	email	email			x
13
14	email	email			x
15
16	email	email
17
18	email	email			x
19
20	email	email
21
22	email	email
23
24	email	email			x
25
26	email	email
27
28	email	email			x
Sheet2

 

[288enzo]

I came across this, did a little tweaking.

Sub Mail_Selection_Range_Outlook_Body()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    Set rng = Sheets("Sheet1").Range("A1:A62").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = Sheets("Roster").Range("E3").Value
        .CC = Sheets("Roster").Range("F3").Value
        .BCC = ""
        .Subject = Sheets("Roster").Range("F1").Value
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

What I'm stuck on now is how to loop through the above when there is an "x" (column H) in the same row as the emails.

Thank you

 

[288enzo]

Updating my code as I've learned a few things. I'm not getting a message "Next without For" highlighting "Next x". Good chance I have a few things out of order, but in general I feel it's correct.

Thank you

Sub Mail_Selection_Range_Outlook_Body()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ToEmail As String
    Dim CCEmail As String
    Dim YesSend As String
    
    Dim x As Long
    Dim LR As Long

    LR = Cells(Rows.Count, 3).End(xlUp).Row
    For x = 50 To LR
    
    YesSend = Range("D" & x).Value
    ToEmail = Range("E" & x).Value
    CCEmail = Range("F" & x).Value
    
    Set rng = Nothing
    Set rng = Sheets("Sheet1").Range("A1:A61").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    If YesSend = "x" Then
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = Sheets("Roster").Range("F1").Value
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With
    On Error GoTo 0
    
    Next x

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[288enzo]

Another update, figured out the previous issue. I was missing End if. I'm no longer receiving any errors, but sadly it isn't working. When I run the code, nothing seems to be happening.

Will someone let me know what I'm missing, or have in the wrong order? Thank you

Sub Mail_Selection_Range_Outlook_Body()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ToEmail As String
    Dim CCEmail As String
    Dim yessend As String
    
    Dim x As Long
    Dim LR As Long

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    LR = Cells(Rows.Count, 3).End(xlUp).Row
    For x = 50 To LR
    
    yessend = Range("D" & x).Value
    ToEmail = Range("E" & x).Value
    CCEmail = Range("F" & x).Value
    
    Set rng = Nothing
    Set rng = Sheets("Sheet1").Range("A1:A61").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If yessend = "x" Then
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = Sheets("Roster").Range("F1").Value
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With
    On Error GoTo 0
    
    End If
    
    Next x

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[288enzo]

I figured it out

Sub Mail_Selection_Range_Outlook_Body()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ToEmail As String
    Dim CCEmail As String
    Dim yessend As String
    
    Dim x As Long
    Dim LR As Long

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 3 To LR
    
    yessend = Range("D" & x).Value
    ToEmail = Range("E" & x).Value
    CCEmail = Range("F" & x).Value
    
    Set rng = Nothing
    Set rng = Sheets("Sheet1").Range("A1:A61").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If yessend = "x" Then
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = Sheets("Roster").Range("F1").Value
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With
    On Error GoTo 0
    
    End If
    
    Next x

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub