Office中国论坛/Access中国论坛
标题:
利用Outlook发邮件
[打印本页]
作者:
roych
时间:
2016-11-14 18:38
标题:
利用Outlook发邮件
论坛里已经有不少这方面的例子了,有用CDO的也有用Outlook组件的。不过个人偏向于用Outlook。
我对Outlook其实并不熟悉,内置的对象基本都是现学现卖的。不过既然有朋友问到,那就写写,算是整合一下吧。
在使用Outlook发邮件之前,必须要先设置好收件和发件服务器。下面,就以网易的yeah.net为例,跟我先设置好吧。一般情况下,登录邮箱网站后,可以在“设置”或者“帮助”(例如,搜狐闪电邮)里找到pop3服务器和SMTP服务器地址:
[attach]60300[/attach]
然后打开Outlook。如果是第一次打开,按向导一步步来就好了。如果已经设置了一个账号,则可以在“文件/信息/添加账号”里自行添加:
[attach]60303[/attach]
个人不太赞成自动添加。毕竟,自动添加时机器识别还不如手动录入准确。然后选择POP3(如果是公司内部架设邮箱服务器的话,应该是Exchange,这里就不深究了):
[attach]60301[/attach]
然后就是填上这些信息了。需要注意的是,姓名是希望显示的名字(例如:不明真相的吃瓜吃饼喝水吃面群众),最下面的用户名是登录邮箱的用户名。填入前面在网站上看到的POP3和SMTP服务器地址:
[attach]60302[/attach]
需要注意的是,大多数邮箱发送时可能都需要验证,因此还需要在“其它设置”里勾选(如果不勾选的话,只能收邮件而不能发邮件):
[attach]60304[/attach]
-------------------------------------------------------------
至此,设置结束。接下来就是写代码完成发送的过程了:
Function SendMailToAll(ByVal strSubject As String, ByVal strBody As String, Optional ByVal blnAttachment As Boolean = False)
'定义Outlook组件
Dim appOutlook As New Outlook.Application
Dim objMailItem As Outlook.MailItem
'定义记录集,用于读取邮箱列表
Dim rst As New ADODB.Recordset
Dim strMailAddress As String
'定义文件拾取器,用于添加多个附件。
Dim fd As FileDialog
Dim i As Long
Set objMailItem = appOutlook.CreateItem(olMailItem)
With objMailItem
'打开邮箱列表并在读取完毕后关闭邮箱列表
rst.Open "tblMailingList", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do Until rst.EOF
strMailAddress = strMailAddress & rst(1) & ";"
rst.MoveNext
Loop
.To = strMailAddress
rst.Close
Set rst = Nothing
'设置主题和主体,如需格式化文本,请使用HTMLBody属性,并编写HTML代码:
.Subject = strSubject
.Body = strBody
'.HTMLBody = "<P style=""color:red;font-size:14px;font-weight:700"">" & strBody & "</p>"
'是否上传附件。如需上传,则打开文件拾取器。
If blnAttachment Then
If MsgBox("您已经选择了上传附件,为了便于一次上传多个附件,请务必确保所有附件都在同一个文件夹内。", vbYesNoCancel) = vbYes Then
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = True
If fd.SHOW = -1 Then
For i = 1 To fd.SelectedItems.Count
.Attachments.Add fd.SelectedItems(i), olByValue, , Mid(fd.SelectedItems(i), InStrRev(fd.SelectedItems(i), "") + 1, Len(fd.SelectedItems(i)))
Next
End If
End If
End If
.Send
End With
End Function
复制代码
大部分注释已经有了,就不再一一解释代码了。需要
引用Outlook库、Office库和ActiveX Data Object库
。运行代码前请确认这一点。
其它:
由于Outlook的安全机制问题,发送时会弹出安全警告,等几秒后点击“允许”即可。网上有说安装VS的Outlook安全管理器插件可以解决这个问题。但个人觉得没必要。特别是分发给用户使用时,是不是每个用户都帮ta安装?
[attach]60305[/attach]
作者:
tmtony
时间:
2016-11-14 18:41
强,我也用Outlook,其它我不会
作者:
ui
时间:
2016-11-14 22:48
很详细的 教程。谢谢分享!
作者:
accben
时间:
2016-11-18 09:09
roych版的教程,赞!!!
欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)
Powered by Discuz! X3.3