利用Excel VBA实现Outlook邮件发送实现

这段时间一直在为公司设计一套基于Excel的数据管理，并利用统计后的数据进行实现邮件发送，在实现过程中却出现了一个小的问题：在邮件发送时，会出现安全提示，只有接受后，才可以邮件发送，通过互联网进行查询，却只能发现部分解决方法。经过相关测试后，现整理如下：

方法一：

Sub a()

Dim objOL As Object

Dim itmNewMail As Object

'引用Microsoft Outlook

Set objOL = CreateObject("Outlook.Application")

Set itmNewMail = objOL.createitem(0)

With itmNewMail

.Subject = "chijanzen Mail Test" '主旨

.HTMLbody = "<table><tr><td></td></tr></table>"

.to = "zhong_wei_cq@hotmail.com "

.Display ‘注意此处使用的不是Send，

End With

On Error GoTo continue

SendEmail:

AppActivate itmNewMail

DoEvents

SendKeys "%s", Wait:=True ‘特别注意此处，该项表示相关于在邮件编辑窗口中，单击发送按钮

DoEvents

AppActivate itmNewMail

GoTo SendEmail

continue:

On Error GoTo 0

Set objOL = Nothing

Set itmNewMail = Nothing

End Sub

方法二：

将Excel中需要发送内容转化为一个小的文档，

然后利用邮件发送Attachments.Add功能添加该文档为邮件附件，如下表示

.Attachments.Add "C:/Documents and Settings/zhongwei/桌面/Basic Payrolll1.xls", , 1, "4th Quarter 1996 Results Chart"

完成后进行邮件发送

方法三：

该方法在Office 2007中测试通过！

打开OUTLOOK，依次单击“工具”｜“宏”｜“安全性”｜

在信任中心窗格中，单击“编程访问”｜选择“从不向我发出可疑活动警告”，

在EXCEL VBA中直接可以使用SEND进行邮件发送。

SUB SENDMAIL（）

dim ou as object

dim oua as object

set ou = createobject("outlook.application")

set oua = ou.createitem(0)

with oua

.to ="zhong_wei_cq@hotmail.com"

.subject="Hello"

.body="Send Test"

.send

end with

end sub