Office中国论坛/Access中国论坛
标题:
使用CDO发送邮件(类模块)
[打印本页]
作者:
fan0217
时间:
2008-3-1 14:37
标题:
使用CDO发送邮件(类模块)
Option Compare Database
Option Explicit
' \\\|///
' \\ - - //
' ( @ @ )
'━━━━━━━━━━━━oOOo-(_)-oOOo━━━━━━━━━━━━━━
'-类名称: SendMail
'-功能描述: 发送邮件
'-参考:
'-使用注意:
'-兼容性: 2000,XP,2003
'-作者: fan0217@tom.com
'-更新日期: 2007-08-22
' Oooo
'━━━━━━━━━━oooO━-( )━━━━━━━━━━━━━━━━━
' ( ) ) /
' \ ( (_/
' \_)
Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Private Const cdoSendUsingPort = 2
Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Private Const cdoBasic = 1
Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Private objConfig ' As CDO.Configuration
Private objMessage ' As CDO.Message
Private Fields ' As ADODB.Fields
Private strSMTPServer As String
Private strSendUserName As String
Private strSendPassword As String
Private strFromMail As String
Private intSMTPConnectionTimeout As Integer
Private intSMTPServerPort As Integer
Public Function Send(toMail As String, subject As String, textBody As String, Optional attachment As String = "") As Boolean
SendInitialize
With objMessage
.to = toMail '接收者的邮件地址
.From = FromMail '发送人的邮件地址
.subject = subject '标题
.textBody = textBody '正文
If attachment <> "" Then
.addAttachment attachment '邮件附件
End If
.Send
End With
Send = True
End Function
Private Sub SendInitialize()
Set objConfig = CreateObject("CDO.Configuration")
Set Fields = objConfig.Fields
With Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = SMTPServer
.Item(cdoSMTPServerPort) = SMTPServerPort
.Item(cdoSMTPConnectionTimeout) = SMTPConnectionTimeout
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = SendUserName
.Item(cdoSendPassword) = SendPassword
.Update
End With
Set objMessage = CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig
End Sub
'可用的外部邮件服务器域名
Public Property Get SMTPServer() As String
SMTPServer = strSMTPServer
End Property
Public Property Let SMTPServer(ByVal value As String)
strSMTPServer = value
End Property
'邮件服务器的用户名
Public Property Get SendUserName() As String
SendUserName = strSendUserName
End Property
Public Property Let SendUserName(ByVal value As String)
strSendUserName = value
End Property
'邮件服务器的密码
Public Property Get SendPassword() As String
SendPassword = strSendPassword
End Property
Public Property Let SendPassword(ByVal value As String)
strSendPassword = value
End Property
'发件人的地址(要和SMTP相同)
Public Property Get FromMail() As String
FromMail = strFromMail
End Property
Public Property Let FromMail(ByVal value As String)
strFromMail = value
End Property
Public Property Get SMTPConnectionTimeout() As Integer
SMTPConnectionTimeout = intSMTPConnectionTimeout
End Property
Public Property Let SMTPConnectionTimeout(ByVal value As Integer)
intSMTPConnectionTimeout = value
End Property
Public Property Get SMTPServerPort() As Integer
SMTPServerPort = intSMTPServerPort
End Property
Public Property Let SMTPServerPort(ByVal value As Integer)
intSMTPServerPort = value
End Property
Private Sub Class_Initialize()
SMTPServerPort = 25
SMTPConnectionTimeout = 10
End Sub
Private Sub Class_Terminate()
Set Fields = Nothing
Set objMessage = Nothing
Set objConfig = Nothing
End Sub
复制代码
作者:
fan0217
时间:
2008-3-1 14:38
Sub Test()
Dim s As New SendMail
s.SMTPServer = "SMTP.tom.com"
s.SendUserName = "fan0217"
s.SendPassword = "**********"
s.FromMail = "fan0217@tom.com"
s.Send "fan0217@tom.com", "测试邮件", "收到请回复!--" & Now
Set s = Nothing
End Sub
复制代码
作者:
fswxs
时间:
2008-3-1 14:41
沙发
学习学习
作者:
huangqinyong
时间:
2008-3-1 15:05
作者:
liwen
时间:
2008-3-1 15:48
.
作者:
tmtony
时间:
2008-3-1 16:37
呵呵, 刚看到一个CDO例程, 又白白收了一个CDO的类库, 赶快收藏了!! 谢谢分享
作者:
c101
时间:
2009-12-23 20:31
谢谢分享
作者:
littlekey
时间:
2010-12-1 15:23
太经典了。
作者:
杨向宇
时间:
2015-3-26 23:19
fan0217 发表于 2008-3-1 14:38
非常实用
作者:
ringo66666
时间:
2016-2-2 12:07
要仔细学习下,谢谢
作者:
764300778
时间:
2016-2-3 01:12
eeee
作者:
764300778
时间:
2016-3-3 21:04
eeee
作者:
yyalm
时间:
2017-6-22 14:40
66666666666666666
作者:
access新新新手
时间:
2017-11-21 12:08
谢谢分享
欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)
Powered by Discuz! X3.3