[讨论]在excel使用vba调用outlook发送邮件的问题

郁闷的拖鞋

因为工作需要批量发送excel表格信息到多个联系人邮箱，今天下午学习使用vba发送邮件。

但是发现每发一封邮件，系统自动弹出安全警告的窗口，汗

 

如果发送一两封邮件还好办，但是发送几十封邮件就很浪费时间！

搜索了一下论坛，发现很多这样的问题贴，貌似很多都没有解决 -__-!!!

其中发现2个方法

方法一是用代码模拟发送邮件确认(代码引用论坛前辈的代码)

QUOTE:

Sub SendMail()
Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 物件模型
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)

With itmNewMail
.Subject = "chijanzen Mail Test" '主旨
.Body = Application.UserName & "發送郵件測試2222" '本文
.To = "171262953@qq.com" '收件者
.Attachments.Add "C:\PDOS.DEF", olByValue, 1, "4th Quarter 1996 Results Chart"
.Display '啟動視窗
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
再次测试中发现，窗口标题为中文时，AppActivate命令不能执行。将AppActivate命令改为Display方法，可解决此问题，即将AppActivate itmNewMail改为itmNewMail.display。

方法二 使用Outlook Security Manager，暂时没有时间测试，我用另外一个方法暂时解决问题。

连接：http://club.excelhome.net/viewthread.php?tid=199798&px=0

 

查阅Microsoft Office 帮助，寻找问题所在和解决办法：（Microsoft Office 2007 Enterprise 帮助文件）

 

 

我收到警告，指出有程序访问电子邮件地址信息或以我的名义发送电子邮件

全部显示

全部隐藏

在许多情况下，可以通过安装防病毒软件并确保定期更新它来避免收到这些 Microsoft Office Outlook 2007 安全警告。本文说明为何会出现安全警告，以及要符合哪些条件才能避免收到这些警告。

本文内容

---

症状

原因

解决方案

---

症状

出现以下一个安全警告：

• “有一个程序正试图访问存储在 Outlook 中的电子邮件地址信息。如果这属意外情况，请单击“拒绝”并确保您的防病毒软件已经更新。”
      
• “有一个程序正试图以您的名义发送电子邮件。如果这属意外情况，请单击“拒绝”并确保您的防病毒软件已经更新。”
      
• “某个程序正试图执行的一项操作可能会导致以您的名义给其他人发送电子邮件。如果这属意外情况，请单击“拒绝”并确保您的防病毒软件已经更新。”

 返回页首

原因

如果某个程序试图访问您存储在 Outlook 通讯簿中的联系人信息，或试图以您的名义发送电子邮件，则会出现这些安全警告。默认情况下，只有 COM 加载项 （COM 加载项：通过添加自定义命令和指定的功能来扩展 Microsoft Office 程序的功能的补充程序。COM 加载项可在一个或多个 Office 程序中运行。COM 加载项使用文件扩展名 .dll 或 .exe。）是受信任的程序。您的电子邮件管理员可能已将特定的加载项添加到“受信任加载项”列表中，以只允许加载这些加载项。任何其他程序均不受信任，而且，由于可能存在着程序不怀好意且设计为使用 Outlook 来传播病毒的风险，因此会出现安全警告。在实施此安全措施之前，诸如 Melissa 和 ILOVEYOU 的病毒能够访问 Outlook，并通过向“联系人”中列出的人员发送邮件来传播。

自动启动的程序  程序可能自动启动。例如，程序试图通过在 Outlook 对象模型中使用 Item.Send 方法来自动发送电子邮件。

您启动的程序  也可能是您启动了程序。例如，您使用一个程序使 PDA 或移动设备与 Outlook 数据同步。

 返回页首

解决方案

解决此安全警告问题

• 如果您不希望某个程序访问 Outlook，或者不确定正试图访问 Outlook 的程序是否可信任，则单击“拒绝”。
• 如果您单击了某个命令或启动了某个程序，并知道它们将要访问 Outlook 数据或使用 Outlook 发送电子邮件，而且认为该程序可信任，则执行下列操作之一：
  • 单击“允许”。
  • 如果系统提示您允许对收件人信息的访问，则选中“允许访问”复选框，单击您允许进行访问的时间量，然后单击“允许”。

     注释    您应选择供其他程序访问 Outlook 数据的最短必需时间量。如果程序需要更多时间，安全警告将会再次出现。

避免此安全警告再次出现

在某些条件下，安装防病毒程序并定期更新它可以避免此安全警告再次出现。这些条件包括：

• 防病毒软件必须与 Microsoft Windows XP Service Pack 2 (SP2) 兼容。请咨询您的防病毒软件供应商。
• 防病毒软件必须定期更新。大多数防病毒程序均能够在线自动更新。请咨询您的防病毒软件供应商。
• 将防病毒软件配置为与其他应用程序共享其更新状态。通常，防病毒程序默认情况下会与其他应用程序共享其更新状态。要检查更新状态设置，请查看防病毒程序的首选项或选项，或咨询您的防病毒软件供应商。

   注释 

  • Office Outlook 2007 依靠 Windows 安全中心来检查防病毒程序是否存在和更新其状态。
  • 如果防病毒软件的订阅已到期或已经不起作用，则在程序试图访问 Outlook 时，可能会再次出现安全警告。

查看信任中心中的安全设置

信任中心中的“编程访问”安全设置提供以下选项：

• “我的防病毒软件处于非活动状态或过时时向我发出可疑活动警告(推荐)”   这是 Office Outlook 2007 中的默认设置。可疑活动是指不受信任的程序试图访问 Outlook。
• “总是向我发出可疑活动警告”   这是最安全的设置，如果有程序试图访问 Outlook，则系统总是会提示您作出是否信任程序的决定。
• “从不向我发出可疑活动警告(不推荐)”   这是最不安全的设置。

要查看这些设置，请执行以下操作：

1. 在“工具”菜单上，单击“信任中心”。
2. 单击“编程访问”。

 注释 

• 如果您的计算机由组织中的 Microsoft Exchange 管理员或 Microsoft Windows Active Directory 域服务管理员进行管理，并且管理员更改了默认的设置且阻止用户进行更改，则用于自定义“编程访问”安全设置的选项将被禁用。
• 如果您的计算机不是由 Microsoft Exchange 管理员或 Microsoft Windows Active Directory 域服务管理员进行管理，并且您是计算机的 Windows 管理员，则可以更改“编程访问”安全设置。但是，不建议这样做。

[此贴子已经被作者于2006-12-10 20:53:24编辑过]

郁闷的拖鞋

可以看到，最简单的方法就是 在Outlook的安全中心中设置 不发送可疑活动警告

 

Outlook,工具菜单

信任中心

 

选择 从不向我发出可疑活动警告(不推荐)

 

测试不再弹出 安全警告的对话框了

系统环境：Windows XP SP2,Mcafee VirusScan 8.0i最新病毒库,Microsoft Office 2007 Enterprise

 

只不过有些奇怪，开了杀毒软件但是检测不到？

 

hxhgxy

谢谢分享！我在2000版遇到同样的问题，目前还没有解决办法。

shaliway

另外一个是什么方法啊？？？

19811123lxys

好啊，我先留个记号，有空再学习，这个对我非常有用啊

coolraywang

我也期待解决办法。

ok520

期待啊～～

销香叶雨

好好学习，天天向上！

shaofengxu2000

我刚觉这个可以用，不用点容许，也基本不出现outlook界面，但是必须再次打开outlook才开始发送邮件。不能直接发送？

shaofengxu2000

Sub SendMail()
Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 物件模型
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)

With itmNewMail
.Subject = "22 Test" '主旨
.Body = Application.UserName & "發送郵件測試2222" '本文
.To = "1986065842@qq.com" '收件者
.Attachments.Add "E:/测试.xls", olByValue, 1, "4th Quarter 1996 Results Chart"
.Display '啟動視窗
End With
'On Error GoTo continue
SendEmail:
AppActivate itmNewMail
DoEvents
SendKeys "%s", Wait:=True
'DoEvents
'itmNewMail.Display
'GoTo SendEmail '发送不成功誓不罢休
'continue:
'On Error GoTo 0
Set objOL = Nothing
Set itmNewMail = Nothing

Shell ("C:\Program Files\Microsoft Office\Office14\OUTLOOK.exe")
Application.Wait Now + TimeValue("00:00:30")
SendKeys "%{F4}", True


End Sub



我加了几句代码，就是打开outlook让邮件发出去，然后再关闭，但时间不好控制，30秒没有附件可以轻松发完，总觉得不完美。