使用CDO發(fā)送郵件(類模塊)

fan0217

1. Option Compare Database
   
2. Option Explicit
   
3. '                           \\\|///
   
4. '                         \\  - -  //
   
5. '                          (  @ @  )
   
6. '━━━━━━━━━━━━oOOo-(_)-oOOo━━━━━━━━━━━━━━
   
7. '-類名稱:       SendMail
   
8. '-功能描述:     發(fā)送郵件
   
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 '發(fā)送人的郵件地址
    
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. '發(fā)件人的地址（要和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

沙發(fā)
學習學習

huangqinyong

liwen

.

tmtony

呵呵, 剛看到一個CDO例程, 又白白收了一個CDO的類庫, 趕快收藏了!! 謝謝分享

c101

謝謝分享

littlekey

太經(jīng)典了。

楊向宇

fan0217 發(fā)表于 2008-3-1 14:38

非常實用

ringo66666

要仔細學習下，謝謝