Sending an email via VBA

Anthony86

Board Regular
Joined
Jan 31, 2018
Messages
57
Hi All,

I'm using some code from the net that sends an email if the due date is close but what I want it to do is if the name in column "F" is the same then send multiple lines in one email, if its different then send a separate email.

Is this possible?

This is the code that I'm using

VBA Code:
Dim Email As String, Subj As String
    Dim Msg As String
    Dim LastRow As Long, NextRow As Long, RowNo As Long
    Dim wsEmail As Worksheet
    Dim OutApp As Object
    Dim OutMail As Object

    Set wsEmail = ThisWorkbook.Sheets("SheetName")
    
    With wsEmail
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For RowNo = 2 To LastRow
            'Change "Date + 30" to suit your timescale
            
            If .Cells(RowNo, "K") = "" And .Cells(RowNo, "E") <= Date + 7 Then
                
                On Error Resume Next
                Set OutApp = GetObject("Outlook.Application")
                    On Error GoTo 0
                    If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
                    Do: Loop Until Not OutApp Is Nothing
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    Email = "User@email.com" 'Change to cell containing e-mail address
                    Subj = "Reminder for Destruction" 'Change to cell containing subject or type subject
                    'Msg = ""
                    
                    Msg = "Hello" & "," & vbCrLf & vbCrLf _
                        & "This is an automated e-mail to let you know that box" & vbCrLf _
                        & wsEmail.Cells(RowNo, "A") & vbCrLf _
                        & "Is due for destruction on " & wsEmail.Cells(RowNo, "E") & vbCrLf _
                        & "Many Thanks, " & vbCrLf
                        
                    .To = Email
                    .CC = ""
                    .SentOnBehalfOfName = "Your User Name" ' This is optional, you can delete this line.
                    .Subject = Subj
                    .ReadReceiptRequested = False
                    .Body = Msg
                    .Display

                End With
            Set OutApp = Nothing
            Set OutMail = Nothing
            .Cells(RowNo, "K") = "S"
            .Cells(RowNo, "L") = "E-mail sent on: " & Now()
        End If
        Next
    End With
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
But in addition to checking the date you also want to check the name?
Or do you just want to check the name?
 

Anthony86

Board Regular
Joined
Jan 31, 2018
Messages
57
Hi,
Yes I want to check the date, then group together in separate emails depending on the name. Hopefully that makes sense
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
Hi @Anthony86,

if the name in column "F" is the same then send multiple lines in one email

But you didn't mention which lines should go in one email.

I put a proposal for you to review:

VBA Code:
Sub test()
  Dim Email As String, Subj As String, Msg As String, wBox As String
  Dim RowNo As Long, i As Long, ky As Variant, cad As Variant
  Dim wsEmail As Worksheet, OutApp As Object, OutMail As Object, dic As Object
 
  Set wsEmail = ThisWorkbook.Sheets("SheetName")
  Set dic = CreateObject("scripting.dictionary")
 
  With wsEmail
    For RowNo = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
      If .Cells(RowNo, "K") = "" And .Cells(RowNo, "E") <= Date + 7 Then
        If dic.exists(.Cells(RowNo, "F").Value) Then
          dic(.Cells(RowNo, "F").Value) = dic(.Cells(RowNo, "F").Value) & RowNo & "|"
        Else
          dic(.Cells(RowNo, "F").Value) = RowNo & "|"
        End If
      End If
    Next
    
    For Each ky In dic.keys
      cad = Left(dic(ky), Len(dic(ky)) - 1)
      cad = Split(cad, "|")
      wBox = ""
      For i = 0 To UBound(cad)
        wBox = wBox & " " & wsEmail.Cells(cad(i), "A") & _
               " Is due for destruction on " & wsEmail.Cells(cad(i), "E") & vbCrLf
        .Cells(cad(i), "K") = "S"
        .Cells(cad(i), "L") = "E-mail sent on: " & Now()
      Next
      On Error Resume Next
      Set OutApp = GetObject("Outlook.Application")
      On Error GoTo 0
      If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
      Do: Loop Until Not OutApp Is Nothing
      Set OutMail = OutApp.CreateItem(0)
      With OutMail
        Email = "User@email.com" 'Change to cell containing e-mail address
        Subj = "Reminder for Destruction" 'Change to cell containing subject or type subject
        Msg = "Hello " & ky & "," & vbCrLf & vbCrLf _
          & "This is an automated e-mail to let you know that box" & vbCrLf _
          & wBox & vbCrLf & "Many Thanks, " & vbCrLf
        .To = Email
        .CC = ""
        .SentOnBehalfOfName = "Your User Name" ' This is optional, you can delete this line.
        .Subject = Subj
        .ReadReceiptRequested = False
        .Body = Msg
        .Display
      End With
      Set OutApp = Nothing
      Set OutMail = Nothing
    Next
  End With
End Sub
 

Anthony86

Board Regular
Joined
Jan 31, 2018
Messages
57

ADVERTISEMENT

Apologies! I'm working with destruction dates and when the date is near I basically want an email sent to remind me, now the criteria for that is just the destruction date but I also want to filter it by account. So if I have 10 boxes due for destruction all belonging to one account then that information will be sent in 1 email, if I have more due dates but relating to different accounts then I want that in a separate email.

I just quickly chucked this together to give you an idea of how my spreadsheet will look. The information I will need in the emails is box number, destruction date, account name.

1575277066464.png


I tested your code above and it pulled stuff that didn't have a date, and ignored the rows that did have them (Not every row will have a destruction date)
 

Anthony86

Board Regular
Joined
Jan 31, 2018
Messages
57
Apologies! I'm working with destruction dates and when the date is near I basically want an email sent to remind me, now the criteria for that is just the destruction date but I also want to filter it by account. So if I have 10 boxes due for destruction all belonging to one account then that information will be sent in 1 email, if I have more due dates but relating to different accounts then I want that in a separate email.

I just quickly chucked this together to give you an idea of how my spreadsheet will look. The information I will need in the emails is box number, destruction date, account name.

View attachment 1119

I tested your code above and it pulled stuff that didn't have a date, and ignored the rows that did have them (Not every row will have a destruction date)

Ignore my previous email its been a long morning LOL, it works!!!
 

Anthony86

Board Regular
Joined
Jan 31, 2018
Messages
57

ADVERTISEMENT

I've played with the code a little more and most of it works perfect, apart from if I leave column 'E' blank it still emails it? How can I stop this from happening as not all rows will be populated with a destruction date.

Everything else works great and I really appreciate that!
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,893
Office Version
  1. 2013
Platform
  1. Windows
Hi,

Might be a bit early for Dante to respond so I'll have a go.
Added a check if 'E' is blank it should skip that row.
If it does have content it continues to the date check line of code

Code:
 With wsEmail
    For RowNo = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
    If .Cells(RowNo, "E") <> "" Then
      If .Cells(RowNo, "K") = "" And .Cells(RowNo, "E") <= Date + 7 Then
        If dic.exists(.Cells(RowNo, "F").Value) Then
          dic(.Cells(RowNo, "F").Value) = dic(.Cells(RowNo, "F").Value) & RowNo & "|"
        Else
          dic(.Cells(RowNo, "F").Value) = RowNo & "|"
        End If
      End If
      End If
    Next
[/Code[
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. Windows
I've played with the code a little more and most of it works perfect, apart from if I leave column 'E' blank it still emails it? How can I stop this from happening as not all rows will be populated with a destruction date.

Everything else works great and I really appreciate that!

Change this line
If .Cells(RowNo, "K") = "" And .Cells(RowNo, "E") <= Date + 7 Then

By this:
If .Cells(RowNo, "K") = "" And .Cells(RowNo, "E") <> "" And .Cells(RowNo, "E") <= Date + 7 Then
 

Watch MrExcel Video

Forum statistics

Threads
1,129,486
Messages
5,636,614
Members
416,929
Latest member
Nitil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top