Colar células do excel no corpo do e-mail outlook através do VBA

Question

Olá pessoal, boa tarde!

Tenho uma macro para envio de e-mails (utilizando html) onde insiro uma imagem no corpo do e-mail.

Atualmente ela funciona normalmente.

Como a imagem retrata um "range" na planilha, onde estão algumas células formatadas, eu gostaria de alterar a macro para que ela colasse este range no corpo do e-mail.

Sei que isso é possível pois manualmente eu colo as celulas no corpo do e-mail no outlook e elas ficam como tabela, inclusive levam a formatação.

Bom, segue abaixo a macro completa.
Acredito que vocês conseguirão identificar o trecho onde eu colo a imagem, o qual eu gostaria de substituir para uma "colagem" das celulas diretamente no e-mail.

Caso alguém possa me ajudar, ficarei grato.

Sub EnviarEmailPedidoVendas()

'#########################################   M A C R O - I N I C I O   #########################################

    'Cria a pasta flashdiariotemp no Desktop do usuário Public
    On Error Resume Next
    MkDir ("C:\Users\Public\enviopedidotemp")
    On Error GoTo 0
    
    'Enviando o e-mail
    Set myOlApp = CreateObject("Outlook.Application")
    Set myitem = myOlApp.CreateItem(olMailItem)
    Set myAttachments = myitem.Attachments

    'Copiando imagem e colando na objeto chart
    Nome_Imagem = "enviopedido" & ".png"
    'Selecionando área para copiar como imagem
    Set rgExp1 = Sheets("ENVIO_PEDIDO").Range("B24:H" & Range("ENVIO_PEDIDO!H22").Value)
    'Copiando como imagem para área de transferência
    rgExp1.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    'Ativando objeto chart
    With ActiveSheet.ChartObjects.Add(
        .Name = "ChartVolumeMetricsDevEXPORT"
        .Activate
    End With
    'Colando em um objeto chart, exportando arquivo, deletando chart
    ActiveChart.Paste
    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "C:\Users\Public\enviopedidotemp\" & Nome_Imagem
    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete

    strbody1 = _
        "<p><font face=""Calibri"" style=""font-size:14.5px"">" & _
        "Olá," & "<br><br>" & _
        "Favor montar pedido com os itens e quantidades abaixo para a franquia " & Range("ENVIO_PEDIDO!G2").Value & ", referente ao projeto Venda Direta - " & Application.Proper(Range("ENVIO_PEDIDO!C2").Value) & "." & "<br><br>" & _
        "<img src=""C:\Users\Public\enviopedidotemp\enviopedido" & ".png"">" & _
        "<br><br>" & _
        "Quaisquer dúvidas, estamos à disposição." & "<br><br>" & _
        "</font>"

    'Assinatura
    strbody2 = strbody1 & "<font face=""Calibri""><span style='color:#000000;font-size:11pt'>" & _
        "Att.<br><br></font>" & _
        "<span style='font-size:10.0pt;font-family:""Verdana"",""sans-serif"";color:#000000'>" & _
        Range("ENVIO!C19").Value & "<br>" & _
        "<b>Departamento " & Range("ENVIO!C20").Value & "</b><br></span>" & _
        "<span style='font-size:8.0pt;font-family:""Verdana"",""sans-serif"";color:#1F497D;'>" & _
        "Tel.: [phone] " & "<br>" & _
        "Email: <a href=""mailto:" & Range("ENVIO!C11").Value & """>" & Range("ENVIO!C11").Value & "</a><br>" & _
        "Site: <a href=""http://www.teste.com.br"">www.teste.com.br</a><br>" & _
        "<br>" & _
        "<img src=""C:\Windows\System32\modelo-de-assinatura.jpg"">" & _
        "</span>" & _
        "<span style='font-size:7.5pt;line-height:115%;font-family:""Verdana"",""sans-serif"";color:green'>" & _
        "<b><i><br><br>Antes de imprimir pense no seu compromisso com o MEIO AMBIENTE !</b></i><br><br>" & _
        "</span>" & _
        "<span style='font-size:7.5pt;font-family:""Verdana"",""sans-serif"";color:gray'>" & _
        "<i>Esta mensagem pode conter informação confidencial e/ou privilegiada." & _
        "Se você não for o destinatário ou a pessoa autorizada a receber esta mensagem, não pode usar, copiar ou divulgar as informações nela" & _
        "contidas ou tomar qualquer ação baseada nessas informações. Se você recebeu esta mensagem por engano, por favor avise imediatamente" & _
        "o remetente, respondendo o e-mail e em seguida apague-o. A Teste não se responsabiliza pelos conteúdos, opiniões" & _
        "e/ou anexos que o remetente desta mensagem possa enviar, sendo este o único responsável." & _
        "</i>" & _
        "</span></p>"

    strbody = strbody2

    On Error Resume Next

    Em_Nome_De = "[e-mail]"
    Email_Para = Range("ENVIO_PEDIDO!B22").Value
    Copia_Para = Range("ENVIO_PEDIDO!C22").Value

    With myitem
        .To = Email_Para
        .CC = Copia_Para
        '.BCC = Copia_Oculta_Para (Não enviar com cópia oculta)
        .SentOnBehalfOfName = Em_Nome_De
        .Subject = "Pedido Venda Direta - " & Application.Proper(Range("ENVIO_PEDIDO!C2").Value)
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Display
        '.Send
    End With

    'Deleta os arquivos na pasta flashdiariotemp
    On Error Resume Next
    Kill "C:\Users\Public\enviopedidotemp\*.*"
    On Error Resume Next
    RmDir "C:\Users\Public\enviopedidotemp\"

    '#########################################   M A C R O - F I M   #########################################

End Sub

Desde já agradeço e fico no aguardo.

Att.

Vinicius

Answer 1

Vinícius,

Uma das melhores formas de fazer isso é salvar uma pasta de trabalho temporária no formato HTM. Em seguida, abrir essa pasta de trabalho, alterar o alinhamento e colocar no corpo do e-mail.

Sugiro estudar o exemplo desta página: http://www.rondebruin.nl/win/s1/outlook/bmail2.htm

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 2

Olá Felipe, boa noite!

Primeiramente obrigado pela resposta.

Olhei o código da página que você enviou e funcionou perfeitamente, com apenas uma ressalva.

Na minha planilha as células possuem formatação condicional, quando eu faço o procedimento de copiar e colar as células no corpo do e-mail manualmente (com o teclado mesmo), isso não afeta, ou seja, a formatação fica correta, porém utilizando a macro do exemplo ele não leva a formatação condicional.

Será que não existe outra forma de fazer ?

Desde já agradeço!

Att,

Vinicius

Answer 3

A técnica apresentada abaixo serve apenas para o Excel 2010 ou superior porque suportam a propriedade DisplayFormat.

Você terá que fazer um laço por todas as células do intervalo e aplicar forçosamente a formatação condicional nelas. Algo como:

Sub Main()
    Set OriginalRange = Range("A1:D10")
    
    Dim iCell As Range
    
    For Each iCell In OriginalRange
        iCell.Interior.Color = iCell.DisplayFormat.Interior.Color
        iCell.Font.Color = iCell.DisplayFormat.Font.Color
        iCell.Font.Bold = iCell.DisplayFormat.Font.Bold
    Next iCell
End Sub

---

http://www.ambienteoffice.com.br - http://www.clarian.com.br

Answer 4

Felipe,

Tentei usar essa parte da formatação condicional, ela até funcionou, mas ela "estragava" a formatação nas células originais, ou seja, eu teria que voltar o procedimento no final da macro.

Baseado na macro que você me indicou, onde ele cria um arquivo temporário em htm, eu aproveitei o momento do arquivo temporário e lá mesmo eu faço a formatação que estava com problema, deste modo fica 100% correto quando cola no e-mail, e aquelas células do temp não me importam a formatação, pois o arquivo é utilizado no processo e ao final é até deletado.

Resumindo, ficou show de bola, o resultado final é exatamente o que eu queria.

Muito obrigado pela sua paciência e retorno.

Caso possa dar uma olhada no link abaixo, trata-se de um ultimo item que quero implementar no mesmo arquivo, é apenas uma barra de progresso que já tenho o código escrito para o comando "if", e não estou conseguindo aplicar para o comando "while". Enfim, se puder me ajudar com mais este item ficaria muito grato.

Novamente muito obrigado!!!

https://social.msdn.microsoft.com/Forums/pt-BR/fcb8b4a6-8eb7-46fc-97ac-7a543945e9c8/macro-para-importao-de-dados-arquivo-txt-com-barra-de-progresso?forum=vbapt

Att.

Vinicius