Excel Macro for automated emails through outlook

[gavstock89]

I have a spreadsheet whereby i want to send an automated email every time I open the file based on a set criteria.

Criteria being -

If column D = "specific text" then send email to column G = "outlook email address" (where the cells in column D and G are in the same row)
Also, once email has been sent, some sort of check so that we don't keep sending the same email every time we reopen the file
I understand I can do this with "hyperlink" formula, but want it automated as soon as spreadsheet is opened.

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. You haven't stated the subject and body of the the emails. Also, we will need an empty column to keep track of which emails have been sent. What is the first blank column in your sheet?

 

[gavstock89]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. You haven't stated the subject and body of the the emails. Also, we will need an empty column to keep track of which emails have been sent. What is the first blank column in your sheet?

lets use column J to track "if sent"

so if column D = "out of date" send email to column G (in this case ben@abc.com) and mark column J once done.

Agreement Ref.	Type	Agreement	Status	Company	Scope of Agreement	Email	Email	Date NDA raised	Email sent?
CA / EXT / 2446	External	CA - External	Live	MURAL	order to evaluate the potential for, or the expansion of, a business relationship between the parties	gavin@abc.com	Gavin	08/11/2021
CA / Int / 2447	Internal	CA - Standard	Out of date	Consulting	discussion and evaluation	ben@abc.com	Ben	09/11/2021

 

[mumps]

Place this macro in the code module for ThisWorkbook. Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the left hand pane, double click on "ThisWorkbook". Copy/paste the macro into the empty window that opens up. Close the window to return to your sheet. Save the workbook as a macro-enabled file. Close the file and re-open it to run the macro.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, srcRng  As Range, status As Range
    Set OutApp = CreateObject("Outlook.Application")
    With ActiveSheet
        .Range("A1").CurrentRegion.AutoFilter 4, "Out of date"
        Set srcRng = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        For Each status In srcRng
            If .Range("J" & status.Row) <> "Yes" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = status.Offset(, 3).Value
                    .Subject = ""
                    .HTMLBody = ""
                    .Display
                End With
            End If
            .Range("J" & status.Row) = "Yes"
        Next status
        .Range("A1").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[gavstock89]

Place this macro in the code module for ThisWorkbook. Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the left hand pane, double click on "ThisWorkbook". Copy/paste the macro into the empty window that opens up. Close the window to return to your sheet. Save the workbook as a macro-enabled file. Close the file and re-open it to run the macro.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, srcRng  As Range, status As Range
    Set OutApp = CreateObject("Outlook.Application")
    With ActiveSheet
        .Range("A1").CurrentRegion.AutoFilter 4, "Out of date"
        Set srcRng = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        For Each status In srcRng
            If .Range("J" & status.Row) <> "Yes" Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = status.Offset(, 3).Value
                    .Subject = ""
                    .HTMLBody = ""
                    .Display
                End With
            End If
            .Range("J" & status.Row) = "Yes"
        Next status
        .Range("A1").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

thanks mumps, if possible, could you explain each line, so if i need to amend in the future (more columns / data etc) i will know how to?

also, i'm guessing when you send it the sending will show as whoever has opened the file? isit possible to send the automated email from a different email address (instead of individual, it could show as coming from the department for example)

 

[gavstock89]

thanks mumps, if possible, could you explain each line, so if i need to amend in the future (more columns / data etc) i will know how to?

also, i'm guessing when you send it the sending will show as whoever has opened the file? isit possible to send the automated email from a different email address (instead of individual, it could show as coming from the department for example)

also, when running trying to send the email i am getting two outlook boxes popping up.

1st showing the recipients address and 2nd just showing "blank"?

 

[mumps]

When you send the email, it will display the email address of the person/department who is attached to the outlook account sending the email. I don' think that can be changed.

when running trying to send the email i am getting two outlook boxes popping up.

1st showing the recipients address and 2nd just showing "blank"?

I tested the macro and it worked properly. I'm not sure what you mean by "outlook boxes".
Here is the code with some explanatory comments:

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, srcRng  As Range, status As Range
    Set OutApp = CreateObject("Outlook.Application")
    With ActiveSheet
        .Range("A1").CurrentRegion.AutoFilter 4, "Out of date" 'filters the data based on 'Out of date' in column 4
        Set srcRng = .Range("D2", .Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) 'sets the srcRng to the visible cells in column D
        For Each status In srcRng 'loops through the 'Email Sent?' column
            If .Range("J" & status.Row) <> "Yes" Then 'checks to see if it has been sent
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = status.Offset(, 3).Value
                    .Subject = ""
                    .HTMLBody = ""
                    .Display
                End With
            End If
            .Range("J" & status.Row) = "Yes" 'once sent, it marks it as 'Yes"
        Next status
        .Range("A1").AutoFilter 'removes the autofilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[gavstock89]

Thanks Mumps, another quick thing.

Is it possible, in the HTMLBody field, to reference a particular cell? For example, the macro finds the "out of date" fields and sends an email to the corresponding address, when the email sends it references column a for example?

 

[mumps]

when the email sends it references column a for example?

Please explain in more detail using an example from your data referring to specific cells, rows and columns.

 

[gavstock89]

So when sending the automated email, i would like it to reference a particular cell (in the same row as the searched field) and return that value?

So from my data set column D = "out of date" send email to column G (in this case ben@abc.com) and mark column J once done, but when sending the email reference column A