Add "sent" check & selection criteria when sending BULK emails in Excel?

[coolkev99]

Please forgive my excel/VBA ignorance. I found a code snippet online that I miraculously was able to adapt and test (it works!) to send emails in-bulk/batch. However I need 3 things added to the code that I haven't figured out...

Overview: What this VBA does is send emails to a fixed email address, only the subject and body change based on what is in the spreadsheet. (emails a ticketing system that routes based on ticket number in the subject.) I linked the macro to a button for 1-click goodness. However...

Here are the 3 things I am trying to add:

1.) Add a confirmation "are you sure you want to send emails?" once button/macro is clicked.
2.) Only send emails to records with "x" in designated column. We manually mark records that need an email send with an "x", so wanting to send emails only to those. Right now code sends to ALL in spreadsheet.
3.) Have the code add an "x" to another(different) column to signify that an email has been sent to that record. Code will not send to that record again unless "x" is cleared.

Here is pic a basic test worksheet of what I'm doing...

VBA:

Sub BulkMail()
Application.ScreenUpdating = False

ThisWorkbook.Activate
'Creating references to Application and MailItem Objects of Outlook
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem

'Creating variable to hold values of different items of mail
Dim sendTo, subj, atchmnt, msg, ccTo, bccTo As String

Dim lstRow As Long

'My data is on sheet "TestMacro" you can have any sheet name.
 
ThisWorkbook.Sheets("TestMacro").Activate
'Getting last row of containing email / subject in column 1.
lstRow = Cells(Rows.Count, 1).End(xlUp).Row

'Variable to hold all email ids

Dim rng As Range
Set rng = Range("A2:A" & lstRow)

'initializing outlook object to access its features
Set outApp = New Outlook.Application
On Error GoTo cleanup 'to handle any error during creation of object.

'Loop to iterate through each row, hold data in of email in variables and send 'mail to each email id.
For Each cell In rng
    sendTo = "testmacro-123@macrotestland.edu"
    subj = Range(cell.Address).Offset(0, 0).Value2 '& "add additional text here"
    msg = "Test only. " & Range(cell.Address).Offset(0, 1).Value2
    'atchmnt = Range(cell.Address).Offset(0, -1).Value2 'NOT USED
    'ccTo = Range(cell.Address).Offset(0, 2).Value2 'NOT USED
    'bccTo = Range(cell.Address).Offset(0, 3).Value2 'NOT USED

    On Error Resume Next 'to hand any error during creation of below object
    Set outMail = outApp.CreateItem(0)
    
    'Writing and sending mail in new mail
    With outMail
        .To = sendTo
        '.cc = ccTo  'NOT USED
        '.BCC = bccTo 'NOT USED
        .Body = msg
        .Subject = subj
        '.Attachments.Add atchmnt 'NOT USED
        '.Display
        .Send 'this send mail without any notification. If you want see mail
        'before send, use .Display method above.
    End With
    On Error GoTo 0 'To clean any error captured earlier
    Set outMail = Nothing 'nullifying outmail object for next mail
 Next cell 'loop ends

cleanup: 'freeing all objects created
        Set outApp = Nothing
        Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub

 

[daverunt]

A couple of changes:

Here's a basic MsgBox to put at the start of the code.

UserResponse = MsgBox("Are you sure you want to send e-mails!", vbYesNo + vbExclamation, "Send Mail?")
  
'If No exit sub
   If UserResponse = vbNo Then
    Exit Sub
   End If

The changes required for determining sending or not:
cell.Offset (Row, Column) is very useful in this type of code.

For Each cell In rng

If cell.Offset(0, 2).Value = "x" And cell.Offset(0, 3).Value = "" Then  '-----------C is 'x' and D is empty then run the send mail code otherwise End If.

    sendTo = "testmacro-123@macrotestland.edu"

    ~~~~rest of code~~~~

Set outMail = Nothing 'nullifying outmail object for next mail

cell.Offset(0, 3).Value = "x" ------------'add x to column D once sent - The And condition will fail when macro runs again
End If

Next cell 'loop ends

 

[coolkev99]

A couple of changes:

Here's a basic MsgBox to put at the start of the code.

UserResponse = MsgBox("Are you sure you want to send e-mails!", vbYesNo + vbExclamation, "Send Mail?")
 
'If No exit sub
   If UserResponse = vbNo Then
    Exit Sub
   End If

The changes required for determining sending or not:
cell.Offset (Row, Column) is very useful in this type of code.

For Each cell In rng

If cell.Offset(0, 2).Value = "x" And cell.Offset(0, 3).Value = "" Then  '-----------C is 'x' and D is empty then run the send mail code otherwise End If.

    sendTo = "testmacro-123@macrotestland.edu"

    ~~~~rest of code~~~~

Set outMail = Nothing 'nullifying outmail object for next mail

cell.Offset(0, 3).Value = "x" ------------'add x to column D once sent - The And condition will fail when macro runs again
End If

Next cell 'loop ends

Thank you SO much Daverunt! I'm trying to get this to work, is there something missing in the line where it writes an "x" after email is sent? (cell.offset(0,3).Value="x" ...) I'm getting an "expected expression" error here.

 

[coolkev99]

Nevermind, I think I have it fixed now. Thanks!!

 

[daverunt]

My guess is I put the comment out apostrophe after the dashes and you copied it?
You fixed it though so that's great.

 

[coolkev99]

Yes, pretty much. My test spreadsheet was macro enabled, and was included with the file. I had intended to use this in my "personal macro workbook" for use on my "real" files. When I added it to the personal macro workbook it didn't work initially, but I removed the "ThisWorkbook.Sheets("TestMacro").Activate" type references and it works. I don't know if this is bad, but it does do the job when I click run.