Alguem poderia me dizer como Copiar uma tabela e enviar direto para o Corpo do email?
Ja consegui gerar a informação tanto em anexo por PDF como por JPG. E ja consegui colocar o JPG no corpo do email.
MAS ESTA IMPOSSIVEL COLAR OS VALORES DA TABELA NO CORPO DO EMAIL.
function sendMailTest()
Dim objEmail
Dim Arquivo
Dim EmailArray
Const cdoSendUsingPort = 2 ' Send the message using SMTP
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
SMTPServer = getVariable("SMTPServer")
Const SMTPPort = 25 ' Port number for SMTP
Const SMTPTimeout = 60 ' Timeout for SMTP in seconds
'Sending mail
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.Fields
With objFlds
'---------------------------------------------------------------------
' SMTP server details
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = SMTPTimeout
.Update
'---------------------------------------------------------------------
End With
'**********COPIANDO TEXTO
'Copiando tabela para o Excel na Pasta
Arquivo = "C:\Documents and Settings\rodrigoteixeira-mtz\Desktop\vendas.xls"
set obj = ActiveDocument.GetSheetObject("CH20")
obj.ExportBiff Arquivo
objEmail.To = getVariable("EmailTo") 'Email Recipient
objEmail.From = getVariable("EmailFrom")
objEmail.Subject = getVariable("EmailSubject") ' Subject
objEmail.TextBody = getVariable("EmailBody")
objEmail.HTMLBody = "<html>Prezados (as), <br><br><b>Segue Estimativa de Venda para</b>: "& date + 1 &"<br><br>Abaixo seguem os Pedidos considerados até às (" & time & "): <br><br><br><img src=""NOVO.jpg""></html>"
'objEmail.AddRelatedBodyPart "C:\Documents and Settings\rodrigoteixeira-mtz\Desktop\estimativa\NOVO.jpg", "NOVO.jpg", CdoReferenceTypeName
objEmail.AddAttachment Arquivo ' Attachement
'**********COLANDO TEXTO
'objEmail.ExportHtml replace(Arquivo,".xls",".html")
'objEmail.AddAttachment(replace(Arquivo,".xls",".html"))
objEmail.Send
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
msgbox ("Estimativa enviado com sucesso!")
end function
'========================================================
'========================================================
'========================================================
'========================================================
'========================================================
'========================================================
'========================================================
function getVariable(varName)
set v = ActiveDocument.Variables(varName)
getVariable = v.GetContent.String
end function
'========================================================
'========================================================
'========================================================
'========================================================
'========================================================
'========================================================
'========================================================
Function Imagem
set obj = ActiveDocument.getSheetObject("CH20")
'ActiveDocument.ClearAll True
ActiveDocument.GetSheetObject("CH20").CopyTableToClipboard true
obj.ExportBitmapToFile ("C:\Documents and Settings\rodrigoteixeira-mtz\Desktop\estimativa\NOVO.jpg")
ActiveDocument.GetApplication.Sleep 60000
'Enviando o Email
'sendMailTest
msgbox "GERADO"
End Function
