- 30 Abr 2015 às 22:09
#560
Senhores
Boa Noite,
Estou de posse de uma Macro para o envio de E-mail's a partir de uma
Planilha Excel, que em função de depurações realizadas, identifiquei
que com o comando .Display a mesma funciona perfeitamente, mas
ao utilizar o comando .Send, ocorre o seguinte erro:
'ERRO 287 - Erro de definição de aplicativo ou de definição de objeto'
Desde já agradeço.
Abraços
Claudio Tavares
A Macro é essa:
Public Sub enviar_email()
'Application.Goto Reference:="SBX_ENVIA_EMAIL"
On Error GoTo Erro
Dim X As Long
Dim outApp As Object
Dim outmail As Object
Dim texto As String
'novas variaveis
Dim mes As String
Dim nome As String
Dim email As String
Dim valor As Double
Dim contator As Integer
contator = 0
mes = InputBox("Digite o mes referente as refeições: exemplo 'Abril/2015' ", "Mês referente", UCase(Format(Date, "MMMM") & "-" & Format(Date, "YYYY")))
Range("A2").Select
Do While ActiveCell.Value <> Empty ' verifica se a celula esta vazia
Set outApp = CreateObject("Outlook.Application")
Set outmail = outApp.CreateItem(0)
'inicia a captura dos dados de cada cliente
nome = ActiveCell.Value ' nome
ActiveCell.Offset(0, 1).Select 'pula coluna
email = ActiveCell.Value 'email
ActiveCell.Offset(0, 25).Select 'pula coluna
valor = ActiveCell.Value 'valor
ActiveCell.Offset(0, -26).Select 'volta primeira coluna
'prepara a mensagem
texto = "Prezado(a) " & nome & vbCrLf & vbCrLf & _
"O valor total das suas refeições em " & mes & " foi de R$: " & Format(valor, "#,##0.00") & vbCrLf & vbCrLf & _
"Atenciosamente" & vbCrLf & vbCrLf
' prepara o email
With outmail
.To = email ' email da variavel
.cc = "c.tavares@uol.com.br" ' seu email
.bcc = ""
.Subject = "VALOR DE SUAS REFEIÇÕES"
.body = texto ' mensagem
.send
'.Display
End With
ActiveCell.Offset(1, 0).Select 'pula coluna 'pula linha indo para proximo cliente
contator = contator + 1
Loop ' volta e fazer tudo de novo ate a ultima linha da coluna "A" estiver vazia
MsgBox "Processo finalizado" & Chr(13) & "Total de email enviado: " & contator, vbInformation, "AVISO"
Exit Sub
'On Error GoTo 0
Erro:
MsgBox "ERRO!" & Err.Number & Chr(13) & Err.Description, vbCritical, "ERRO"
Set outmail = Nothing
Set outApp = Nothing
End Sub
Public Sub formulario_email()
UserForm1.Show
End Sub
Boa Noite,
Estou de posse de uma Macro para o envio de E-mail's a partir de uma
Planilha Excel, que em função de depurações realizadas, identifiquei
que com o comando .Display a mesma funciona perfeitamente, mas
ao utilizar o comando .Send, ocorre o seguinte erro:
'ERRO 287 - Erro de definição de aplicativo ou de definição de objeto'
Desde já agradeço.
Abraços
Claudio Tavares
A Macro é essa:
Public Sub enviar_email()
'Application.Goto Reference:="SBX_ENVIA_EMAIL"
On Error GoTo Erro
Dim X As Long
Dim outApp As Object
Dim outmail As Object
Dim texto As String
'novas variaveis
Dim mes As String
Dim nome As String
Dim email As String
Dim valor As Double
Dim contator As Integer
contator = 0
mes = InputBox("Digite o mes referente as refeições: exemplo 'Abril/2015' ", "Mês referente", UCase(Format(Date, "MMMM") & "-" & Format(Date, "YYYY")))
Range("A2").Select
Do While ActiveCell.Value <> Empty ' verifica se a celula esta vazia
Set outApp = CreateObject("Outlook.Application")
Set outmail = outApp.CreateItem(0)
'inicia a captura dos dados de cada cliente
nome = ActiveCell.Value ' nome
ActiveCell.Offset(0, 1).Select 'pula coluna
email = ActiveCell.Value 'email
ActiveCell.Offset(0, 25).Select 'pula coluna
valor = ActiveCell.Value 'valor
ActiveCell.Offset(0, -26).Select 'volta primeira coluna
'prepara a mensagem
texto = "Prezado(a) " & nome & vbCrLf & vbCrLf & _
"O valor total das suas refeições em " & mes & " foi de R$: " & Format(valor, "#,##0.00") & vbCrLf & vbCrLf & _
"Atenciosamente" & vbCrLf & vbCrLf
' prepara o email
With outmail
.To = email ' email da variavel
.cc = "c.tavares@uol.com.br" ' seu email
.bcc = ""
.Subject = "VALOR DE SUAS REFEIÇÕES"
.body = texto ' mensagem
.send
'.Display
End With
ActiveCell.Offset(1, 0).Select 'pula coluna 'pula linha indo para proximo cliente
contator = contator + 1
Loop ' volta e fazer tudo de novo ate a ultima linha da coluna "A" estiver vazia
MsgBox "Processo finalizado" & Chr(13) & "Total de email enviado: " & contator, vbInformation, "AVISO"
Exit Sub
'On Error GoTo 0
Erro:
MsgBox "ERRO!" & Err.Number & Chr(13) & Err.Description, vbCritical, "ERRO"
Set outmail = Nothing
Set outApp = Nothing
End Sub
Public Sub formulario_email()
UserForm1.Show
End Sub
