使用CDO发送邮件(类模块)

fan0217

1. Option Compare Database
   
2. Option Explicit
   
3. '                           \\\|///
   
4. '                         \\  - -  //
   
5. '                          (  @ @  )
   
6. '━━━━━━━━━━━━oOOo-(_)-oOOo━━━━━━━━━━━━━━
   
7. '-类名称:       SendMail
   
8. '-功能描述:     发送邮件
   
9. '-参考:
   
10. '-使用注意:
    
11. '-兼容性:       2000,XP,2003
    
12. '-作者:         fan0217@tom.com
    
13. '-更新日期：    2007-08-22
    
14. '                            Oooo
    
15. '━━━━━━━━━━oooO━-(   )━━━━━━━━━━━━━━━━━
    
16. '                    (   )   ) /
    
17. '                     \ (   (_/
    
18. '                      \_)
    
19. Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    
20. Private Const cdoSendUsingPort = 2
    
21. Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    
22. Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
    
23. Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
    
24. Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
    
25. Private Const cdoBasic = 1
    
26. Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
    
27. Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
    
28. Private objConfig ' As CDO.Configuration
    
29. Private objMessage ' As CDO.Message
    
30. Private Fields ' As ADODB.Fields
    
31. Private strSMTPServer As String
    
32. Private strSendUserName As String
    
33. Private strSendPassword As String
    
34. Private strFromMail As String
    
35. Private intSMTPConnectionTimeout As Integer
    
36. Private intSMTPServerPort As Integer
    
37. 
    
38. Public Function Send(toMail As String, subject As String, textBody As String, Optional attachment As String = "") As Boolean
    
39.     SendInitialize
    
40.     With objMessage
    
41.         .to = toMail '接收者的邮件地址
    
42.         .From = FromMail '发送人的邮件地址
    
43.         .subject = subject '标题
    
44.         .textBody = textBody '正文
    
45.         If attachment <> "" Then
    
46.             .addAttachment attachment '邮件附件
    
47.         End If
    
48.         .Send
    
49.     End With
    
50.     Send = True
    
51. End Function
    
52. 
    
53. Private Sub SendInitialize()
    
54.     Set objConfig = CreateObject("CDO.Configuration")
    
55.     Set Fields = objConfig.Fields
    
56.     With Fields
    
57.         .Item(cdoSendUsingMethod) = cdoSendUsingPort
    
58.         .Item(cdoSMTPServer) = SMTPServer
    
59.         .Item(cdoSMTPServerPort) = SMTPServerPort
    
60.         .Item(cdoSMTPConnectionTimeout) = SMTPConnectionTimeout
    
61.         .Item(cdoSMTPAuthenticate) = cdoBasic
    
62.         .Item(cdoSendUserName) = SendUserName
    
63.         .Item(cdoSendPassword) = SendPassword
    
64.         .Update
    
65.     End With
    
66.     Set objMessage = CreateObject("CDO.Message")
    
67.     Set objMessage.Configuration = objConfig
    
68. End Sub
    
69. 
    
70. '可用的外部邮件服务器域名
    
71. Public Property Get SMTPServer() As String
    
72.     SMTPServer = strSMTPServer
    
73. End Property
    
74. Public Property Let SMTPServer(ByVal value As String)
    
75.     strSMTPServer = value
    
76. End Property
    
77. 
    
78. '邮件服务器的用户名
    
79. Public Property Get SendUserName() As String
    
80.     SendUserName = strSendUserName
    
81. End Property
    
82. Public Property Let SendUserName(ByVal value As String)
    
83.     strSendUserName = value
    
84. End Property
    
85. 
    
86. '邮件服务器的密码
    
87. Public Property Get SendPassword() As String
    
88.     SendPassword = strSendPassword
    
89. End Property
    
90. Public Property Let SendPassword(ByVal value As String)
    
91.     strSendPassword = value
    
92. End Property
    
93. 
    
94. '发件人的地址（要和SMTP相同）
    
95. Public Property Get FromMail() As String
    
96.     FromMail = strFromMail
    
97. End Property
    
98. Public Property Let FromMail(ByVal value As String)
    
99.     strFromMail = value
    
100. End Property
     
101. 
     
102. Public Property Get SMTPConnectionTimeout() As Integer
     
103.     SMTPConnectionTimeout = intSMTPConnectionTimeout
     
104. End Property
     
105. Public Property Let SMTPConnectionTimeout(ByVal value As Integer)
     
106.     intSMTPConnectionTimeout = value
     
107. End Property
     
108. 
     
109. Public Property Get SMTPServerPort() As Integer
     
110.     SMTPServerPort = intSMTPServerPort
     
111. End Property
     
112. Public Property Let SMTPServerPort(ByVal value As Integer)
     
113.     intSMTPServerPort = value
     
114. End Property
     
115. 
     
116. Private Sub Class_Initialize()
     
117.     SMTPServerPort = 25
     
118.     SMTPConnectionTimeout = 10
     
119. End Sub
     
120. 
     
121. Private Sub Class_Terminate()
     
122.     Set Fields = Nothing
     
123.     Set objMessage = Nothing
     
124.     Set objConfig = Nothing
     
125. End Sub

复制代码

fan0217

1. Sub Test()
   
2. Dim s As New SendMail
   
3. s.SMTPServer = "SMTP.tom.com"
   
4. s.SendUserName = "fan0217"
   
5. s.SendPassword = "**********"
   
6. s.FromMail = "fan0217@tom.com"
   
7. s.Send "fan0217@tom.com", "测试邮件", "收到请回复！--" & Now
   
8. Set s = Nothing
   
9. End Sub

复制代码

fswxs

沙发
学习学习

huangqinyong

liwen

.

tmtony

呵呵, 刚看到一个CDO例程, 又白白收了一个CDO的类库, 赶快收藏了!! 谢谢分享

c101

谢谢分享

littlekey

太经典了。

杨向宇

fan0217 发表于 2008-3-1 14:38

非常实用

ringo66666

要仔细学习下，谢谢