ExcelmacrosVBA电子邮件提醒
所以基本上在我的模拟excel文件中，我有一个提醒列，当指定的date已经过去，然后在该列中popup“发送提醒”。 我正在尝试链接“发送提醒”以触发自动电子邮件。 目的是自动发送提醒电子邮件。
当“Sub或者function not defined”遇到麻烦，但是我把Solver添加到了我的引用中。 现在，当我在macros>运行，没有电子邮件正在发送。
我用它的代码 –
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 列是名称 – date – 提醒 – 电子邮件（1，2，3，4），我正在使用Excel 2010
我感激时间和精力！ 谢谢！
首先从Tools – > References – > Microsoft outlook 12.0库或任何其他版本的Outlook库中selectoutlook库。
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
这将在发送电子邮件后用余数是更新您的工作簿
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.
希望它可以帮助你
GD Sylvie，
作为一个build议，请参阅下面的代码设置，了解如何安排一个子程序，允许根据您指定的select标准发送邮件。
设置您的工作簿，如下所示：
在“工具”|“引用”下的VB编辑器中，find“Microsoft Outlook xx.x对象库”，其中xx.x表示您正在使用的Outlook的版本。 （另请参阅： https ： //msdn.microsoft.com/en-us/library/office/ff865816.aspx ）当您为对象获取智能感知build议时，这将使编码更容易。
将OutlookApp声明为public，高于所有其他子/函数等等（即在您的“编码”窗口的顶部）
Public OutlookApp As Outlook.Application
你的sendReminderMail（）子
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
添加sendMailfunction：
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