VBA Excel to Send Email based on email address in cell

[raytej82]

Hi,

I'm having trouble with code to send out an email to only the email person in cell N (for instance, email address in cell N10 may be different to cell N11 ETC) with the subject in cell D of outstanding tasks (tasks allocated will be different, i.e taks D10 will be different to text in D11, I am using outlook app, I would like the file attached, however I'm also happy with the file path being linked within the email or even a screenshot of the file.

I have a cell within the file in cell P10 to display the file path for reference within the code.

Thanks in advance.

 

[Logit]

Sub SendEmail()
    Dim OutlookApp As Object
    Dim MItem As Object
    Dim cell As Range
    Dim email_ As String
    Dim cc_ As String
    Dim subject_ As String
    Dim body_ As String

     'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
     'Loop through the rows
    For Each cell In Columns("N").Cells.SpecialCells(xlCellTypeConstants)

        email_ = cell.Value
        subject_ = cell.Offset(0, -10).Value
        'Create Mail Item and send it
        Set MItem = OutlookApp.CreateItem(0)
        With MItem
            .To = email_
            .CC = cc_
            .Subject = subject_
            .Attachments.Add Application.ActiveWorkbook.FullName
            .Display
        End With
    Next
End Sub

 

[raytej82]

Morning,
Many thanks for your help, the code works. However, I'm now trying to add a bit in so that within the body of the email it has a screenshot. I'm thinking a visual email within the body will have more an impact and the email hopefully will get read.

I'd also like it so that the email just sends rather than having to manually select send of each outlook message window.

I've tried to merge your code and another code I found, however it doesn't like it. This is the other code I found.

[CODE=xls]Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()

    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range

    On Error GoTo StopMacro

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

    
    Set Sendrng = Worksheets("Close Checklist").Range("A1:I100")

    Set AWorksheet = ActiveSheet

    With Sendrng

        .Parent.Select

        Set rng = ActiveCell

        .Select

      
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

           
            .Introduction = "This is test mail 2."

            With .Item
                .To = "email@.com"
                .CC = ""
                .BCC = ""
                .Subject = "My subject"
                .Send
            End With

        End With

        rng.Select
    End With

    
    AWorksheet.Select

StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub

[/CODE]