Notifications
Clear all

Enviando uma Tabela do excel por email Outlook

3 Posts
1 Usuários
0 Reactions
903 Visualizações
(@mat17)
Posts: 0
New Member
Topic starter
 

Pessoal, boa tarde,

Desculpa por criar um novo post, mas estou tentando procurar uma Vb mas esta dificil de achar do jeito que preciso, como nao manjo nada, fica ainda mais complicado pois nao consigo modifica para oque preciso.

Preciso de uma VB "simples", que sera executada quando apertar um botao mesmo, ao executala, ela ira abir o email do outlook, copiara o assunto do email que estará em uma celula especifica, ex A1, copiara os contatos que estaráo em outra celula ex B1, e copiara uma tabela exemplo E5:J10 e ira colar no corpo do email.

Nao precisa anexar o arquivo por email e ela só sera executada quando apertar um botao mesmo, só lembrando que ela nao podera enviar o email automaticamente, a principio eu que irei apertar para enviar.

Alguem poderia da uma Luz para este caso.

Abraçosssssss

 
Postado : 10/02/2017 1:57 pm
(@mat17)
Posts: 0
New Member
Topic starter
 

Este codigo faz exatamente oque preciso, segue abaixo pra alguem que precise.

SSub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
Set rng = Sheets("Plan1").Range("e5:i23").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


Dim destinatario As String
destinatario = Sheets("Plan1").Range("n5")

Dim cliente As String
cliente = Sheets("Plan1").Range("n6")

Dim assunto As String
assunto = Sheets("Plan1").Range("n7")


On Error Resume Next
With OutMail
.To = destinatario
.CC = cliente
.BCC = ""
.Subject = assunto
.HTMLBody = RangetoHTML(rng)
'.Send 'or use .Display
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
 
Postado : 11/02/2017 12:29 pm
(@mat17)
Posts: 0
New Member
Topic starter
 

Pessoal, boa tarde.

Estou com um problema, e gostaria da ajuda de vocês se for possível, estou quebrando a cabeça, mas como nao manjo nada de VB, nao consigo resolver.

Seguinte.

No código acima, a linha Set rng = Sheets("Plan1").Range("e5:i23").SpecialCells(xlCellTypeVisible), define que eu quero pegar as informações nas celulas e5:i23 e colar no email blz? Oque preciso é invés de deixar já definido no código que eu quero copiar as células e5:i23, quero que o código vá na célula A1 por exemplo, e lá ele pegue a informação das células que quero copiar que no caso seria a e5:i23, e a partir dai ele copiar a informação para depois colar no email. Por que desta gambiarra? na célula e5:i23 eu tenho uma tabela que muda constantemente de tamanho e isso atrapalha pois tem certas informações que não quero copiar, sendo assim, eu quero definir manualmente na célula A1 quais celulass ele deve copiar.

Vlw turma.

 
Postado : 15/02/2017 3:43 pm