设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2530|回复: 3

[与其它组件] 利用Outlook发邮件

[复制链接]
发表于 2016-11-14 18:38:19 | 显示全部楼层 |阅读模式
论坛里已经有不少这方面的例子了,有用CDO的也有用Outlook组件的。不过个人偏向于用Outlook。
我对Outlook其实并不熟悉,内置的对象基本都是现学现卖的。不过既然有朋友问到,那就写写,算是整合一下吧。


在使用Outlook发邮件之前,必须要先设置好收件和发件服务器。下面,就以网易的yeah.net为例,跟我先设置好吧。一般情况下,登录邮箱网站后,可以在“设置”或者“帮助”(例如,搜狐闪电邮)里找到pop3服务器和SMTP服务器地址:



然后打开Outlook。如果是第一次打开,按向导一步步来就好了。如果已经设置了一个账号,则可以在“文件/信息/添加账号”里自行添加:

个人不太赞成自动添加。毕竟,自动添加时机器识别还不如手动录入准确。然后选择POP3(如果是公司内部架设邮箱服务器的话,应该是Exchange,这里就不深究了):

然后就是填上这些信息了。需要注意的是,姓名是希望显示的名字(例如:不明真相的吃瓜吃饼喝水吃面群众),最下面的用户名是登录邮箱的用户名。填入前面在网站上看到的POP3和SMTP服务器地址:

需要注意的是,大多数邮箱发送时可能都需要验证,因此还需要在“其它设置”里勾选(如果不勾选的话,只能收邮件而不能发邮件):

-------------------------------------------------------------
至此,设置结束。接下来就是写代码完成发送的过程了:
  1. Function SendMailToAll(ByVal strSubject As String, ByVal strBody As String, Optional ByVal blnAttachment As Boolean = False)
  2.     '定义Outlook组件
  3.     Dim appOutlook As New Outlook.Application
  4.     Dim objMailItem As Outlook.MailItem
  5.    
  6.     '定义记录集,用于读取邮箱列表
  7.     Dim rst As New ADODB.Recordset
  8.     Dim strMailAddress As String
  9.    
  10.     '定义文件拾取器,用于添加多个附件。
  11.     Dim fd As FileDialog
  12.     Dim i As Long
  13.    
  14.     Set objMailItem = appOutlook.CreateItem(olMailItem)
  15.    
  16.     With objMailItem
  17.    
  18.         '打开邮箱列表并在读取完毕后关闭邮箱列表
  19.         rst.Open "tblMailingList", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  20.             Do Until rst.EOF
  21.                 strMailAddress = strMailAddress & rst(1) & ";"
  22.                 rst.MoveNext
  23.             Loop
  24.         .To = strMailAddress
  25.         rst.Close
  26.         Set rst = Nothing
  27.         
  28.         '设置主题和主体,如需格式化文本,请使用HTMLBody属性,并编写HTML代码:
  29.         .Subject = strSubject
  30.         .Body = strBody
  31.         
  32.         '.HTMLBody = "<P style=""color:red;font-size:14px;font-weight:700"">" & strBody & "</p>"
  33.         
  34.         '是否上传附件。如需上传,则打开文件拾取器。
  35.         If blnAttachment Then
  36.             If MsgBox("您已经选择了上传附件,为了便于一次上传多个附件,请务必确保所有附件都在同一个文件夹内。", vbYesNoCancel) = vbYes Then
  37.                 Set fd = Application.FileDialog(msoFileDialogFilePicker)
  38.                 fd.AllowMultiSelect = True
  39.                 If fd.SHOW = -1 Then
  40.                     For i = 1 To fd.SelectedItems.Count
  41.                         .Attachments.Add fd.SelectedItems(i), olByValue, , Mid(fd.SelectedItems(i), InStrRev(fd.SelectedItems(i), "") + 1, Len(fd.SelectedItems(i)))
  42.                     Next
  43.                 End If
  44.             End If
  45.         End If
  46.         
  47.         .Send
  48.     End With
  49. End Function
复制代码
大部分注释已经有了,就不再一一解释代码了。需要引用Outlook库、Office库和ActiveX Data Object库。运行代码前请确认这一点。
其它:
由于Outlook的安全机制问题,发送时会弹出安全警告,等几秒后点击“允许”即可。网上有说安装VS的Outlook安全管理器插件可以解决这个问题。但个人觉得没必要。特别是分发给用户使用时,是不是每个用户都帮ta安装?

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1经验 +10 金钱 +30 技术 +1 V币 +5 收起 理由
5988143 + 10 + 30 + 1 + 5 (技术)原创精品课程、录像、代码、教程(.

查看全部评分

点击这里给我发消息

发表于 2016-11-14 18:41:02 来自手机 | 显示全部楼层
强,我也用Outlook,其它我不会
来自: 微社区
发表于 2016-11-14 22:48:17 | 显示全部楼层
很详细的 教程。谢谢分享!
发表于 2016-11-18 09:09:47 | 显示全部楼层
roych版的教程,赞!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-3-28 18:01 , Processed in 0.094017 second(s), 34 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表