从 Excel 发送 Outlook 电子邮件

Question

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.

Answer 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

Answer 2

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.
(ie 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