Option Explicit
Private cdoMessage As CDO.Message
Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
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 cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Private Const SMTPConnectionTimeout = 60
Private E_SendUsingMethod As Byte       '邮件发送选项
Private E_SendSMTPAuthenticate As Byte  'SMTP验证选项
Private E_SMTPServer As String          'SMTP服务器
Private E_SMTPServerPort As Integer     'SMTP服务器端口
Private E_SendUserName As String        '用户名
Private E_SendPassword As String        '密码

Private E_EmailTo As String
Private E_EmailFrom As String
Private E_EmailSubject As String
Private E_EmailTextBody As String
Public Property Get SendUsingPort() As Byte
SendUsingPort = E_SendUsingMethod
End Property
Public Property Let SendUsingPort(SUPort As Byte)
E_SendUsingMethod = SUPort
End Property
Public Property Get SMTPAuthenticate() As Byte
SMTPAuthenticate = E_SendSMTPAuthenticate
End Property
Public Property Let SMTPAuthenticate(SMTPType As Byte)
E_SendSMTPAuthenticate = SMTPType
End Property
Public Property Get SMTPServer() As String
SMTPServer = E_SMTPServer
End Property
Public Property Let SMTPServer(sServerName As String)
E_SMTPServer = sServerName
End Property
Public Property Get SMTPServerPort() As Integer
SMTPServerPort = E_SMTPServerPort
End Property
Public Property Let SMTPServerPort(ServerPort As Integer)
E_SMTPServerPort = ServerPort
End Property
Public Property Get SendUserName() As String
SendUserName = E_SendUserName
End Property
Public Property Let SendUserName(ServerLoginUser As String)
E_SendUserName = ServerLoginUser
End Property
Public Property Get SendPassword() As String
SendPassword = E_SendPassword
End Property
Public Property Let SendPassword(Pwd As String)
E_SendPassword = Pwd
End Property
Public Property Get EmailTo() As String
EmailTo = E_EmailTo
End Property
Public Property Let EmailTo(strEmail As String)
E_EmailTo = strEmail
End Property
Public Property Get EmailFrom() As String
EmailFrom = E_EmailFrom
End Property
Public Property Let EmailFrom(strEmail As String)
E_EmailFrom = strEmail
End Property
Public Property Get EmailSubject() As String
EmailSubject = E_EmailSubject
End Property
Public Property Let EmailSubject(strSubject As String)
E_EmailSubject = strSubject
End Property
Public Property Get EmailTextBody() As String
EmailTextBody = E_EmailTextBody
End Property
Public Property Let EmailTextBody(strTextBody As String)
E_EmailTextBody = strTextBody
End Property
'Error sub
Private Sub ErrorSub()
MsgBox "Error " & Err.Number & " " & Err.Description, vbInformation + vbOKOnly, "Error Information"
End Sub
'Send Email
Public Function SendEmail() As Boolean
On Error GoTo Err_SendEmail
'Configuration
    With cdoMessage.Configuration.Fields
.Item(cdoSendUsingMethod) = E_SendUsingMethod
.Item(cdoSMTPServer) = E_SMTPServer
.Item(cdoSMTPServerPort) = E_SMTPServerPort
.Item(cdoSMTPConnectionTimeout) = SMTPConnectionTimeout
.Item(cdoSMTPAuthenticate) = E_SendSMTPAuthenticate
.Item(cdoSendUserName) = E_SendUserName
.Item(cdoSendPassword) = E_SendPassword
.Update
End With
'Message
    With cdoMessage
.To = E_EmailTo
.From = E_EmailFrom
.Subject = E_EmailSubject
.TextBody = E_EmailTextBody
.Send
End With
SendEmail = True
Exit Function
Err_SendEmail:
ErrorSub
End Function
'Verify Data
Private Function VerifyData() As Boolean
Dim StrMsg As String
If E_SMTPServer = "" Then
StrMsg = "SMTP服务器名没有填写|"
        GoTo ErrorInput
End If
If E_SMTPServerPort <= 0 Then
StrMsg = "SMTP 端口没有填写|"
        GoTo ErrorInput
End If
If E_SendUserName = "" Then
StrMsg = "用户名没有填写|"
        GoTo ErrorInput
End If
If E_SendPassword = "" Then
StrMsg = "密码没有填写|"
        GoTo ErrorInput
End If
VerifyData = True
Exit Function
ErrorInput:
MsgBox GetLanguageStr(StrMsg), vbInformation + vbOKOnly, GetLanguageStr("信息提示|")
End Function
'Save messages of configuration to database
Public Function SaveConfigInfo(Optional ByVal intUpdateTyp As Integer = 1) As Boolean
Dim objDBB As Object
Dim strSQL As String
On Error GoTo Err_SaveConfigInfo
If Not VerifyData Then Exit Function
'代码略
    SaveConfigInfo = True
Exit Function
Err_SaveConfigInfo:
ErrorSub
End Function
'Read messages of configuration from database
Public Sub ReadConfigInfo()
Dim objDBB As Object
Dim objRst As ADODB.Recordset
On Error GoTo Err_ReadConfigInfo
'其中的代码略
    If Not objRst.EOF Then
E_SendUsingMethod = objRst!SendUsingMethod
E_SMTPServer = objRst!SMTPServer
E_SMTPServerPort = objRst!ServerPort
E_SendSMTPAuthenticate = objRst!Authenticate
E_SendUserName = objRst!SendUserName
E_SendPassword = objRst!SendPassword
E_EmailTo = objRst!EmailTo
End If
If objRst.State = adStateOpen Then objRst.Close
Set objRst = Nothing
Set objDBB = Nothing
Exit Sub
Err_ReadConfigInfo:
ErrorSub
End Sub
Private Sub Class_Initialize()
E_SendUsingMethod = 2
E_SendSMTPAuthenticate = 1
E_SMTPServerPort = 25
Set cdoMessage = New CDO.Message
End Sub