VBS 自动发送邮件

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41

'--------------------------------------------------------------------------------- '函数名称 : 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