从Excel发送Outlook电子邮件
从Excel发送Outlook电子邮件
提问于 2015-06-26 21:24:09
在我的Excel文件中，我有一个提醒列，当指定的日期已过时，该列中会弹出“发送提醒”。
我正在试着发送一封提醒邮件。
我遇到了"Sub or function not defined“的问题，但我通过将Solver添加到我的引用中来修复它。现在，当我单击宏>运行时，不会发送任何电子邮件。
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列是名称-日期-提醒-电子邮件(1、2、3、4)，我使用的是Excel 2010。
回答 2
Stack Overflow用户
发布于 2015-09-10 03:31:41
首先从“工具”-->“参考”-->“Microsoft outlook 12.0库”或任何其他版本的outlook库中选择outlook库。
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.希望能对你有所帮助
Stack Overflow用户
发布于 2015-10-18 13:46:00
设置子例程以根据选择条件发送邮件。
按如下方式设置工作簿：
在VB编辑器的“工具”|“引用”下，找到“”Microsoft Outlook xx.x对象库“”，其中xx.x表示您正在使用的Outlook版本。(另请参阅：https://msdn.microsoft.com/en-us/library/office/ff865816.aspx)这将使编码变得更容易，因为您可以为您的对象获得智能感知建议。
将OutlookApp声明为public，高于所有其他subs/函数等。
(例如，在你的“编码”窗口的顶部)
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增加了sendMail函数：
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/31074364
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号