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

  • Pergunta

  • 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.: (17) 2136-2660 " & "<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 = "financeiro@teste.com.br"
        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

    segunda-feira, 4 de abril de 2016 18:41

Respostas

Todas as Respostas

  • 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

    terça-feira, 5 de abril de 2016 11:25
    Moderador
  • 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

    quarta-feira, 6 de abril de 2016 01:08
  • 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

    quarta-feira, 6 de abril de 2016 14:27
    Moderador
  • 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

    quinta-feira, 7 de abril de 2016 20:18