利用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 = "

"

     .to = "[email protected] "

      .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 ="[email protected]"

    .subject="Hello"

    .body="Send Test"

    .send

end with

 

end sub