'---------------------------------------------------------------------------------
'函數名稱 : SendMail
'函數功能 : 自動發送郵件功能
'函數輸入 : SendTo----收件人,多個收件人可使用";"隔開
' MailTopic----郵件主題
' MailBody----郵件內容,此處內容格式為Html
' MailAttachment---郵件附件,多個附件可使用";"隔開
'函數輸出 : Boolean,郵件是否發送成功
'---------------------------------------------------------------------------------
Function SendMail(SendFrom,Password,SendTo,MailTopic,MailBody,MailAttachment)
On error resume next
MS_Space = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.BodyPart.Charset = "GBK"
Email.From = SendFrom
Email.To = SendTo
Email.Subject = MailTopic
Email.Htmlbody = MailBody
If MailAttachment <> "" Then
For i=0 to Ubound(Split(MailAttachment,";"))
Email.AddAttachment Split(MailAttachment,";")(i)
Next
End If
With Email.Configuration.Fields
.Item(MS_Space&"sendusing") = 2
.Item(MS_Space&"smtpserver") = "smtp."&Split(SendFrom,"@",-1, vbTextCompare)(1)
.Item(MS_Space&"smtpserverport") = 25
.Item(MS_Space&"smtpauthenticate") = 1
.Item(MS_Space&"sendusername") =Split(SendFrom,"@",-1,vbTextCompare)(0)
.Item(MS_Space&"sendpassword") = Password
.Update
End With
Err.clear
Email.Send
If Err.number<>0 Then
SendMail=False
Else
SendMail=True
End If
Set Email=Nothing
End Function