- 04 Jan 2019 às 14:21
#39736
Montei uma ferramenta que me gera 30 relatórios diferentes, me solicitaram que fizesse uma outra ferramenta que abrisse esses 30 relatórios copiasse a área de relatório (essa área varia de acordo com o relatório) jogasse todas as 30 imagens numa aba da planilha, para que o analista pudesse validar as imagens antes de enviar via em-mail. Até aqui Foi tudo ok.
A parte que eu parei foi pegar essas 30 imagens e colar no corpo do e-mail e enviar, selecionar todas imagens eu consigo, consigo copiar, e consigo fazer o envio do e-mail a única coisa que eu não consigo fazer é COLAR as imagens no corpo do email. Segue meu código:
CÓDIGO: SELECIONAR TODOS
Sub Envia_Emails()
Sheets("Relatório").Pictures.Select
Selection.Copy
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "frederico@zzzzz.com.br"
.CC = ""
.BCC = ""
.Subject = "Relatório de Produtividade Atualização: " & Now()
.Body = "" <- Aqui no body eu já tentei varias coisas mas quando eu abro o outlook ele perde a referência que copiou da planilha
.send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
Se alguém puder ajudar.
Abs
A parte que eu parei foi pegar essas 30 imagens e colar no corpo do e-mail e enviar, selecionar todas imagens eu consigo, consigo copiar, e consigo fazer o envio do e-mail a única coisa que eu não consigo fazer é COLAR as imagens no corpo do email. Segue meu código:
CÓDIGO: SELECIONAR TODOS
Sub Envia_Emails()
Sheets("Relatório").Pictures.Select
Selection.Copy
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "frederico@zzzzz.com.br"
.CC = ""
.BCC = ""
.Subject = "Relatório de Produtividade Atualização: " & Now()
.Body = "" <- Aqui no body eu já tentei varias coisas mas quando eu abro o outlook ele perde a referência que copiou da planilha
.send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
Se alguém puder ajudar.
Abs
