lcamargo...

.. declare uma variável String para o e-mail, por exemplo:

Dim destinatario As String

Indique uma forma da variável receber o e-mail, por exemplo:

destinatario = Sheets("Plan1").Range("A1")

e na linha:


.To = "[email protected]"


substitua por:

.To = destinatario

Teste e reporte se o resultado não for esperado ou se restar dúvida.

Grande Edson!!

Show de bola camarada, assunto resolvido. Aos que de repente possam precisar tanto da minha questão, quanto da macro para envio do email, fica o código...

Abraço a todos!

Pessoal,

Estou fazendo um cronograma com tarefas mensais para a empresa onde trabalho, todos os dias tem tarefas a serem cumpridas, estou quebrando a cabeça para fazer com que o Excel fizesse a função de Lembrete (por email) de determinada tarefa as pessoas envolvidas.

Eu já tenho a macro que envia email, porém estou com uma limitação do VBA que trata dos destinatários de emails, pois da forma como esta a macro envia apenas para o destinatário previamente cadastrado dentro do VBA, ou seja não há flexibilidade de destinatário.

Assim sendo eu preciso que a macro envie apenas para o destinatário que aparece na planilha (ou seja de acordo com a tarefa), assim em certos momentos vai ser um determinado email e em outros momentos será outro, tem como o VBA buscar este campo na própria planilha?

Segue abaixo código de envio que estou utilizando, a parte do envio esta em destaque. Desde já agradeço.

----------------------------------------------------------------------

Sub 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("MySheet").Range("D4:D12").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)

On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "Atualização Cronograma"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .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

Essa rotina funciona apenas com o Outlook aberto, certo?

Nem usando o código do link:
http://www.tomasvasquez.com.br/blog/microsoft-office/vba-abrindo-o-microsoft-outlook

Funcionou. Só abrindo o Outlook.
Preciso enviar e-mail sem abrir o Outlook e com anexo, mas usando o Outlook.
Alguém pode ajudar?

Atenciosamente,
Adriano Prachthäuser

Adriano,

Acredito eu que não teria como, pois quando enviamos um email sem estar com o Outlook aberto, o email fica na caixa de saída e não envia enquanto o outlook não for aberto.

Desta forma acho que não teria como, a não ser que você faça com que a macro abra o outlook, envie o email e depois feche o novamente. De qualquer forma não sei te dizer como fazer isso e nem se é possivel.

Att
Leandro

Olá icamargo,

Há algum tempo estou tentando fazer uma macro parecida com a sua.

Como uso o seu código, não entendo muito bem, estou aprendendo.

Apenas colar e executar não dá certo, queria fazer um teste antes de adaptar para o meu caso.

Se você puder me dar uma dica... E também onde eu coloco a variável declarada conforme explicou o Edson...

Por favor, me ajude!!

Obrigada

Christianne

Olá Cristianne, a variavel string mencionada pelo Edson deve ser colocada antes da parte grifada em vermelho, para a então seja buscado os destinatarios conforme definido. Segue codigo como ficou no final das contas.

Sub 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("MySheet").Range("D4:D12").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("Alerta_email").Range("b2")

Dim cliente As String
cliente = Sheets("Alerta_email").Range("b3")

Dim assunto As String
assunto = Sheets("Alerta_email").Range("c5")

On Error Resume Next
With OutMail
.To = destinatario
.CC = cliente
.BCC = ""
.Subject = assunto
.HTMLBody = RangetoHTML(rng)
.Send 'or use .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

lcamargo

você poderia disponibilizar sua planilha em funcionamento com as opções de definir os destinatários para envio?

Olá,
Muito legal essa marcro. É isso oq eu preciso, mas não sei exatamente onde fazer as alterações que tenho que fazer:
1- Uso o Lotus Notes e não OutLook
2- o usuário é [email protected]
3- Tenho que enviar um e-mail informando que o prazo de entrega (com base na planilha) é "HOJE".

Alguem pode me ajudar e enviar um comando + ou - pronto..??

Valeu pela ajuda galerinha.
Abraços,

Icamargo, boa tarde.

Estou modificando o seu codigo para oque preciso e até esta funcionando, mas estou com problemas no questio do email querer enviar a mensagem sozinha, eu preciso que ele somente abra o email e cole as informaçoes de contatos etc.

Comentei a linha .Send 'or use .Display porém, ele tenta enviar o email em segundo plano, porem, o email nao é enviado.

Resolvi o problema. a linha diz ".Send 'or use .Display" na verdade existem duas opçoes na linha, ou o .Send para enviar, ou o .Display para abrir o email sem enviar.