1

In my Excel file I have a reminder column, when the assigned date has passed then "Send Reminder" pops up in the column.

I am trying to send a reminder email.

I ran into trouble with "Sub or function not defined" but I fixed it by adding Solver into my references. Now when I click on macro > run , no email is sent.

Sub SendEmail()
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim iCounter As Integer
    Dim MailDest As String
    
    Set OutLookApp = CreateObject("OutLook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    
    With OutLookMailItem
        MailDest = ""
        For iCounter = 1 To WorksheetFunction.CountA(Column(4))
            If MailDest = "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
                MailDest = Cells(iCounter, 4).Value
            ElseIf MailDest <> "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
                MailDest = MailDest & ":" & Cells(iCounter, 4)
            End If
        Next iCounter
    
        .BCC = MailDest
        .Subject = "FYI"
        .Body = "Reminder"
        .Send
    End With
    
    Set OutLookMailItem = Nothing
    Set OutLookApp = Nothing
End Sub

The columns are Name - Date - Reminder - Email (1, 2, 3, 4) and I am using Excel 2010.

Community
  • 1
  • 1
Sylvie Lahaie
  • 11
  • 1
  • 2
  • 1
    You appear to be joining multiple e-mail addresses in `MailDest` by seperating them with `":"` when you should use a semi-colon `";"`. That may be contributing to the issue, can you post any error messages you're getting. – andshrew Jun 26 '15 at 13:49
  • Does the code run to its conclusion or does an error message appear? – kaybee99 Jun 26 '15 at 14:06
  • No error message appears! But no e-mail is actually sent. – Sylvie Lahaie Jun 26 '15 at 14:38
  • Welcome to Stack Overflow! Please don't use [macros] for MS Office or VBA. [macros tag wiki](http://stackoverflow.com/tags/macros/info) – Byron Wall Jun 26 '15 at 15:07
  • For what I am trying to do, what would you recommend? – Sylvie Lahaie Jun 26 '15 at 17:11
  • Denied by IT see comment - https://stackoverflow.com/questions/48104512/how-to-send-mail-when-the-send-does-not-work. SendKeys to risk breaking the rules https://stackoverflow.com/questions/17883088/sending-mail-using-outlook-where-the-send-method-fails. – niton Sep 20 '19 at 11:28

2 Answers2

1

First select the outlook library from Tools--> References--> Microsoft outlook 12.0 library or any other versions of outlook library you have .

Sub Email()
'Dim OutlookApp As Outlook.Application
Dim OutlookApp
Dim objMail
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim x As Long
lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow

mydate1 = Cells(x, 6).Value
mydate2 = mydate1

Cells(x, 9).Value = mydate2

datetoday1 = Date
datetoday2 = datetoday1

Cells(x, 10).Value = datetoday2

If mydate2 - datetoday2 = 1 Then

'Set OutlookApp = New Outlook.Application
Set OutlookApp = CreateObject("Outlook.Application")
Set objMail = OutlookApp.CreateItem(olMailItem)
objMail.To = Cells(x, 5).Value
k
With objMail
.Subject = "Payment Reminder"
.Body = "Your payment is due." & vbCrLf & "Kindly ignore if already paid." & vbCrLf & "Hari"
'.Display
.send
End With
Cells(x, 7) = "Yes"
Cells(x, 7).Interior.ColorIndex = 3
Cells(x, 7).Font.ColorIndex = 2
Cells(x, 7).Font.Bold = True
Cells(x, 8).Value = mydate2 - datetoday2
End If
Next
Set OutlookApp = Nothing
Set objMail = Nothing

End Sub

This will update your workbook with remainder Yes after sending emails

Title   F.Name  L.Name  Mob.No  Email    Date   Remainder   Days Diff   Date No Today as No
Mr  trolls  t   9787687644  xxx@gmail.com   9/5/2015    Yes 1   42252   42251.

Hope it helps you

Hariharan V
  • 21
  • 2
  • 11
-1

Setup for a subroutine to send mail based on selection criteria.

Set up your Workbook as follows:

In VB Editor under Tools|References find 'Microsoft Outlook xx.x Object Library', where xx.x represents the version of Outlook that you are working with. (see also: https://msdn.microsoft.com/en-us/library/office/ff865816.aspx) This will make for easier coding as you get intellisense suggestions for your objects.

Declare OutlookApp as public, above all other subs/functions etc.
(i.e. at the top of your 'coding'window)

Public OutlookApp As Outlook.Application

your sendReminderMail() sub

Sub SendReminderMail()
    Dim iCounter As Integer
    Dim MailDest As String

    On Error GoTo doOutlookErr:
    Set OutlookApp = New Outlook.Application
    
    For iCounter = 1 To WorksheetFunction.CountA(Columns(4))
        MailDest = Cells(iCounter, 4).Value
        
        If Not MailDest = vbNullString And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
          sendMail MailDest
          MailDest = vbNullString
        End If
        
    Next iCounter

'basic errorhandling to prevent Outlook instances to remain open in case of an error.
doOutlookErrExit:
    If Not OutlookApp Is Nothing Then
        OutlookApp.Quit
    End If
    Exit Sub

doOutlookErr:
    MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
    Resume doOutlookErrExit
    
End Sub

added sendMail Function:

Function sendMail(sendAddress As String) As Boolean
    
    'Initiate function return value
    sendMail = False
    On Error GoTo doEmailErr:
    
    'Initiate variables
    Dim OutLookMailItem As Outlook.MailItem
    Dim htmlBody As String
    
    'Create the mail item
    Set OutLookMailItem = OutlookApp.CreateItem(olMailItem)
    
    'Create the concatenated body of the mail
    htmlBody = "<html><body>Mail reminder text.<br></body></html>"
    
    'Chuck 'm together and send
    With OutLookMailItem
    
        .BCC = sendAddress
        .Subject = "Mail Subject"
        .HTMLBody = htmlBody
        .Send
      
    End With
    
    sendMail = True

doEmailErrExit:
    Exit Function

doEmailErr:
    MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
    Resume doEmailErrExit
    
End Function
Community
  • 1
  • 1
mtholen
  • 1,631
  • 2
  • 15
  • 27