利用Outlook发邮件

roych

论坛里已经有不少这方面的例子了，有用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安装？

tmtony

强，我也用Outlook,其它我不会
来自: 微社区

ui

很详细的 教程。谢谢分享！

accben

roych版的教程，赞！！！