转自:https://www.cnblogs.com/metree/p/3436764.html
一、以下代码简单实现了利用VBA通过Outlook发送邮件的功能:
具体代码和详细注释如下:
Sub Example() '简单调用示例,调用中各参数分别为:"收件人","抄送人","密送人","主题","正文","附件"。SendEmail "zhangjianshu_cqu@126.com", "", "", "jmail_free.rar", "hi,how are you !", "E:\jmail_free.rar"End SubSub SendEmail(To_Addr As String, Cc_Addr As String, Bcc_Addr As String, SubjectText As String, BodyText As String, AttachedObject As String) Dim OutlookObj As ObjectDim OutlookNewMail As Object'创建Outlook对象Set OutlookObj = CreateObject("Outlook.Application") Set OutlookNewMail = OutlookObj.CreateItem(olMailItem) '错误异常处理On Error GoTo SendEmail_Failed With OutlookNewMail .To = To_Addr '收件人地址.cc = Cc_Addr '抄送人地址.BCC = Bcc_Addr '密送人地址.Subject = SubjectText '邮件主题.Body = BodyText '邮件内容.Attachments.Add AttachedObject '粘贴附件'.Send '若采用.Send方式发送邮件,则Outlook容易出现“有一个程序正试图以您的名义发送电子邮件”提示,比较招人讨厌。'若坚持采用此种方式发送邮件,又不想Outlook出现讨厌的提示,则需对Outlook进行如下设置:'"工具" -> "信任中心" -> "编程访问" -> 选择"从不向我发出可疑活动警告"End With'以下是采用通过激活Outlook,然后模拟按键方式进行邮件发送SendEmail_Sending: '显示发送邮件窗口 OutlookNewMail.display '以下目的是留给系统充分的时间点击发送键For j = 1 To 200DoEvents Next'点击邮件发送SendKeys "%s", Wait:=True'遗憾的是,这里无法显示服务器发送状态,只能返回Excel发送的结果MsgBox "邮件已发送!"Exit Sub SendEmail_Failed: MsgBox "发送失败,原因为:" & Err.Description Exit SubEnd Sub
联系客服