CDO.Message发送邮件的实现代码

HMG 专栏收录该内容
2 篇文章 0 订阅


#include "hmg.ch"

Function Main

Local cPath:= GetCurrentFolder()+"\", loCfg, loMsg
Local sm_to:="hqhuiyi@163.com"
Local sm_from:="408139391@qq.com"
Local sm_cc:=""
Local sm_bcc:=""
Local sm_userauth:="408139391"
Local sm_passauth:="hy19630911"
Local sm_subject:="Test Message Subject"
Local sm_servsmtp:="smtp.qq.com"
Local sm_portsmtp:=465
Local sm_confirm_read:=.F.
Local sm_Body:='<html><head><meta content="text/html; charset=utf-8" http-equiv="content-type"><title></title></head><body>'+;
   'Test message body</body></html>'
Local sm_TextBody:="Test message body"
Local lSSL:=.T.  
Local sm_priority:=1
Local sm_att:=cPath+"AttSample.zip"


#xcommand TRY              => BEGIN SEQUENCE WITH {|o| break(o)}
#xcommand CATCH [<!oErr!>] => RECOVER [USING <oErr>] <-oErr->
#xcommand FINALLY          => ALWAYS
 
//Please note, when using the :AddAttachment method in your scripts you must use a fully qualified pathname as the argument to the method.  Using just a file name or a relative path will produce the error The specified protocol is unknown
//By repeating the :AddAttachment method you can attach more than one file.
//sm_priority:=2 is for High; =1 for Normal; =0 for Low
//sm_confirm_read:=.T. is for return receipt

TRY
 
 loCfg := CREATEOBJECT( "CDO.Configuration" )
 WITH OBJECT loCfg:Fields
  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" )      :Value := sm_servsmtp
  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" )  :Value := sm_portsmtp
  :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" )       :Value := 2
  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := .T.
  :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" )      :Value := lSSL
  :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" )    :Value := sm_userauth
  :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" )    :Value := sm_passauth
  :Update()
 END WITH

 loMsg := CREATEOBJECT ( "CDO.Message" )

 WITH OBJECT loMsg
  :BodyPart:Charset := "utf-8"
  :Configuration := loCfg
   :From          := sm_from
  :To            := sm_to
  :Subject       := sm_subject
  :Bcc   := sm_bcc
  :Cc    := sm_cc
  :TextBody  := sm_TextBody   //plain text
  :HTMLBody  := sm_Body   //html text
  :HTMLBodyPart:Charset := "utf-8"
  :AddAttachment (sm_att)
  WITH OBJECT loMsg:Fields
   :Item("urn:schemas:httpmail:importance"):Value := sm_priority
   :Item("urn:schemas:mailheader:X-Priority"):Value := sm_priority-1
   IF sm_confirm_read
    :Item("urn:schemas:mailheader:return-receipt-to"):Value := sm_from
    :Item("urn:schemas:mailheader:disposition-notification-to"):Value := sm_from
   ENDIF
   :Update()
  ENDWITH
  :DSNOptions := 0
  :Send()
  MsgInfo('Success')
 ENDWITH
 
CATCH oError
  MsgStop ( "The email was not sent."+CRLF+;
    "Error:      "+TRANSFORM(oError:GenCode, NIL)+CRLF+;
    "SubCode:   "+TRANSFORM(oError:SubCode, NIL)+CRLF+;
    "OSCode:    "+TRANSFORM(oError:OsCode, NIL)+CRLF+;
    "SubSystem: "+TRANSFORM(oError:SubSystem, NIL)+CRLF+;
    "Description:      "+oError:Description)
END


RETURN
*********************************************************************************

'Date: 2010/6/18
'Author: Demon
'QQ: 380401911
'E-mail: still.demon@gmail.com
'Website: http://demon.tw

Const Email_From = "ddd@163.com" '发件人邮箱
Const Password = "password" '发件人邮箱密码
Const Email_To = "380401911@qq.com" '收件人邮箱

Set CDO = CreateObject("CDO.Message") '创建CDO.Message对象
CDO.Subject = "From Demon" '邮件主题
CDO.From = Email_From '发件人地址
CDO.To = Email_To '收件人地址
CDO.TextBody = "Hello world!" '邮件正文
cdo.AddAttachment = "C:\hello.txt" '邮件附件文件路径
Const schema = "http://schemas.microsoft.com/cdo/configuration/" '规定必须是这个,我也不知道为什么

With CDO.Configuration.Fields '用with关键字减少代码输入
.Item(schema & "sendusing") = 2 '使用网络上的SMTP服务器而不是本地的SMTP服务器
.Item(schema & "smtpserver") = "smtp.gmail.com" 'SMTP服务器地址
.Item(schema & "smtpauthenticate") = 1 '服务器认证方式
.Item(schema & "sendusername") = Email_From '发件人邮箱
.Item(schema & "sendpassword") = Password '发件人邮箱密码
.Item(schema & "smtpserverport") = 465 'SMTP服务器端口
.Item(schema & "smtpusessl") = True '是否使用SSL
.Item(schema & "smtpconnectiontimeout") = 60 '连接服务器的超时时间
.Update '更新设置
End With

CDO.Send '发送邮件

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

表情包
插入表情
评论将由博主筛选后显示,对所有人可见 | 还能输入1000个字符
©️2021 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值