Incluir uma imagem na mensagem do email usando o objeto CDO.Message
Na função Envia_Mail que é chamada dentro da Envia_Email, procurem por AddRelatedBodyPart
O nome da imagem tem que ser o mesmo definido na variável cImagem e no método AddRelatedBodyPart
O teste:
Código: Selecionar todos
AzulHTML := '<span style="color:#0000FF">'
VermelhoHTML := '<span style="color:#FF0000">'
QuebraHTML := "<br>"
cImagem:='<img src="asaprev1.jpg" alt="Monitor AsaPrev">'
cMensagem:=AzulHTML +"Log de confirma‡Æo de atualiza‡Æo de sistema em: "+hb_DtoC(Date(),"DD/MM/YYYY")+QuebraHTML+;
VermelhoHTML+"Feito pelo Monitor AsaPrev."+QuebraHTML+;
cImagem
Envia_Email({hb_DirBase()+"ASAPREV.NEW"},,cMensagem,.F.) //Envia email para mim informando que foi feito a atualização.
A função que eu envio email é esta:
Modifiquei algumas informações por motivo de segurança.
Código: Selecionar todos
#include "error.ch"
#include "fileio.ch"
FUNCTION Envia_Email(aArquivo, cAssunto, cMensagem, lInformaEnvio)
LOCAL lOk := .T.
hb_Default(@aArquivo, {})
hb_Default(@cAssunto, "Log de atualiza‡Æo de sistema em: "+hb_DtoC(Date(),"DD/MM/YYYY"))
hb_Default(@cMensagem, "Log de erro de sistema em: "+hb_DtoC(Date(),"DD/MM/YYYY"))
hb_Default(@lInformaEnvio, .T.)
aFiles := aArquivo // pode ser uma matriz com vários endereços
cSubject := cAssunto
aQuem := "Alexandre Simäes <asimoesluz@gmail.com>"
cMsg := cMensagem
cServerIp := "smtp.gmail.com" // servidor smtp
cFrom := "Sistema AsaPrev <xhbsistemas@gmail.com>"
cUser := "xhbsistemas@gmail.com"
cPass := "senha"
vPORTSMTP := 465
aCC := "Alexandre Simäes <a_1964_luz@yahoo.com.br>" // caracteres entre aspas
aBCC := "" // caracteres entre aspas
lConf := .F.
lSSL := .T.
lOk := Config_Mail(aFiles,;
cSubject,;
aQuem,;
cMsg,;
cServerIp,;
cFrom,;
cUser,;
cPass,;
vPORTSMTP,;
aCC,;
aBCC,;
lConf,;
lSSL,;
lInformaEnvio)
RETURN lOk
FUNCTION Config_Mail(aFiles, cSubject, aQuem, cMsg, cServerIp, cFrom, cUser, cPass, vPORTSMTP, aCC, aBCC, lConf, lSSL, lInformaEnvio)
LOCAL lRet
LOCAL oCfg, oErroMail
LOCAL lAut:=.T. //cdpar000->mauth
hb_Default(@lInformaEnvio, .T.)
TRY
oCfg := WIN_OleCreateObject( "CDO.Configuration" )
WITH OBJECT oCfg:Fields
:Item("http://schemas.microsoft.com/cdo/configuration/smtpserver"):Value:= cServerIp
:Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport"):Value:= vPORTSMTP
:Item("http://schemas.microsoft.com/cdo/configuration/sendusing"):Value:= 2
:Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"):Value:= lAut
:Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl"):Value:= lSSL
:Item("http://schemas.microsoft.com/cdo/configuration/sendusername"):Value:= AllTrim(cUser)
:Item("http://schemas.microsoft.com/cdo/configuration/sendpassword"):Value:= AllTrim(cPass)
:Update()
END WITH
lRet:=.T.
CATCH oErroMail
IF lInformaEnvio
hwg_MsgStop("Não foi possível enviar o e-mail!" +hb_EOL()+ ;
"Error: " + Transform(oErroMail:GenCode, nil) + ";" +hb_EOL()+ ;
"SubC: " + Transform(oErroMail:SubCode, nil) + ";" +hb_EOL()+ ;
"OSCode: " + Transform(oErroMail:OsCode, nil) + ";" +hb_EOL()+ ;
"SubSystem: " + Transform(oErroMail:SubSystem, nil) + ";" +hb_EOL()+ ;
"Mensagem: " + oErroMail:Description, "Atenção",150,10000,2,.T.)
ENDIF
lRet := .F.
END
//--> FIM DAS CONFIGURAÇOES.
IF lRet
lRet := Envia_Mail(oCfg,;
cFrom,;
aQuem,;
aFiles,;
cSubject,;
cMsg,;
aCC,;
aBCC,;
lConf,;
lAut,;
lSSL,;
cServerIp,;
lInformaEnvio)
ENDIF
RETURN lRet
FUNCTION Envia_Mail(oCfg, cFrom, cDest, aFiles, cSubject, cMsg, aCC, aBCC, vEmaiL_Conf, lAut, lSSL, cServerIp, lInformaEnvio)
LOCAL aTo
LOCAL lRet
LOCAL nEle, oErroMail
hb_Default(@lInformaEnvio, .T.)
aTo:= { cDest } //--> PARA
nEle := 1
FOR I:=1 TO Len(aTo)
TRY
IF lInformaEnvio
MsgTroca("Aguarde, processando o envio do email.")
ENDIF
oMsg := WIN_OleCreateObject( "CDO.Message" )
WITH OBJECT oMsg
:Configuration = oCfg
:From = cFrom
:To = aTo[i]
:Cc = aCC
:BCC = aBCC
:Subject = cSubject
:AddRelatedBodyPart(hb_DirBase()+"img\asaprev1.jpg","asaprev1.jpg",1)
:Fields:Item("urn:schemas:mailheader:Content-ID"):Value = "<asaprev1.jpg>"
:Fields:Item("urn:schemas:mailheader:Content-Disposition"):Value = "inline"
:Fields:Update()
:HTMLBody = cMsg
FOR X := 1 TO Len( aFiles )
:AddAttachment(AllTrim(aFiles[x]))
hwg_DoEvents()
NEXT
:Fields("urn:schemas:mailheader:disposition-notification-to"):Value := cFrom
:Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"):Value := lAut
:Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl"):Value := lSSL
:Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver"):Value := cServerIp
:Fields:update()
:Send()
hwg_DoEvents()
END WITH
IF lInformaEnvio
MsgFim()
hwg_MsgInfo("E-mail enviado com sucesso", "Atenção")
ENDIF
lRet:=.T.
CATCH oErroMail
IF lInformaEnvio
MsgFim()
hwg_MsgStop("Não foi possível enviar a mensagem: "+cSubject+hb_EOL()+;
"para o email: " + aTo[i]+"." +hb_EOL()+;
"Erro: " +oErroMail:Description , "Atenção")
ENDIF
lRet:=.F.
END
NEXT
oCfg := Nil
oMsg := Nil
RETURN lRet
