Excel bulk emails thru VBA (same file and table)

[Apaka]

Hi. I've been trying to set up a simple table to use to send mass emails and must be doing something wrong. The code is not mine but believe it works; I have done something to cause it to not work. I've tired several solutions and think Ron De Bruin's is probably the most straight-forward so was hoping to use that. In short, I have several fields, but the key fields are in columns E (email address) and F (Yes/No). The Yes/No option is to select which email addresses I send to.

Following is the code I tried.

>>> use code - tags <<<

Sub Test1()
'For Tips see: rondebruin.nl....
'Working in Office 2000-2016
    Dim outApp As Object
    Dim outMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set outApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "F").Value) = "Y" Then

            Set outMail = outApp.CreateItem(0)
            On Error Resume Next
            With outMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
                .Send  'Or use Display
            End With
            On Error GoTo 0
            Set outMail = Nothing
        End If
    Next cell

cleanup:
    Set outApp = Nothing
    Application.ScreenUpdating = True
End Sub

Thank you for your consideration and assistance.

 

[RDAngelo]

Try changing this line

        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "F").Value) = "Y" Then

to this

        If cell.Value Like "?*@?*.?*" And _
           UCase(Cells(cell.Row, "F").Value) = "Y" Then

 

[Apaka]

Thank you for the reply. the problem I have with the code I'm trying is nothing even happens. Outlook doesn't compose an email or anything. While I'm sure there is goodness in changing case from lower to UPPER, I think the problem is something else.

 

[Apaka]

I changed is to UCase and tried to run. Nothing happens. Attached is the file because maybe I'm missing something. Thank you for any help.

 

[Apaka]

Hello everyone. I read more on a site (Ron De Bruin) and noticed he has additional code that marks which emails have been sent already, which is even better. I still can't get Outlook to launch, although the cells are getting marked "send". I am a very basic user of VBA, which is why the issue is not obvious to me. Following is the code I'm hoping to use. I am also attaching a file, which has code to send (Test1), and code to send and mark that it has been sent (Test2).

Thank you for any assistance.

As You have noted >>> use code - tags <<<

Sub Test2()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           UCase(Cells(cell.Row, "F").Value) = "Y" _
           And LCase(Cells(cell.Row, "G").Value) <> "send" Then

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date."
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send  'Or use Display
            End With
            On Error GoTo 0
            Cells(cell.Row, "G").Value = "send"
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[RDAngelo]

This works on your template

Sub Test3()
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    For Each cell In Sheet1.Columns("E").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value2 Like "?*@?*.?*" And _
           UCase(cell.Offset(, 1).Value2) = "Y" And _
           cell.Offset(, 2).Value2 <> "Sent" Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = cell.Value2
                .Subject = "Reminder"
                .Body = "Dear " & cell.Offset(, -4).Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
                .Display                          'or .Send
            End With
            cell.Offset(, 2) = "Sent"
            Set OutMail = Nothing
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

I recommend that you do not include any error handling until after you know your code functions properly.

 

[Apaka]

Thank you. Yes, it works. Thank you again.

 

[RDAngelo]

Glad I could help!