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

• 分類            VBS