Notifications
Clear all

Email por Macro não Funciona Worksheet_change

43 Posts
4 Usuários
0 Reactions
5,202 Visualizações
(@jmadao)
Posts: 0
New Member
Topic starter
 

Pessoal, boa noite
Tenho uma planilha que desejo que a mesma envie emails automatico a partir de um resultado em uma determinada celula.
Basicamente esta assim, a macro precisa verificar se a coluna "F", possui o a escrita SIM, se for verdadeiro a mesma envia os valores da linha da celula que contem a escrita sim.

Hoje a macro funciona, porem so funciona se eu escrever a palavra "Sim" e eu deixar uma formula de "SE" e mesmo que voltar "SIM", a macro nao reconhece e nao envia o email.
Sou novato no VBA, montei a macro com varios artigos que fui pesquisando, porem agora nao consigo mais evoluir.

A macro esta Sub de Change, fiz umas pesquisa e algumas pessoas disseram que era para usar Sub Calculate, porem nao obtive exito.
Se alguém conseguir me ajudar, fico muito agradeçido.

Segue scrip e estou utilizando:

Private Sub Worksheet_change(ByVal Target As Range)

Dim OutApp As Object
Dim OutMail As Object
Dim texto As String

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

linha = ActiveCell.Row - 1
If Target.Address = "$F$" & linha Then

If Plan1.Cells(linha, 6) = "SIM" Then

End If

HTML = HTML & "<head>"
HTML = HTML & "<body>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial Unicode MS'>Caros, " & cliente & "</b></font></br>" '<b> é bold. <i> é itálico
HTML = HTML & "<br>" 'Equivalente ao enter
HTML = HTML & "<br>"

HTML = HTML & "</body>"
HTML = HTML & "</html>"

With OutMail
.To = Plan4.Cells(linha, 7)
'"Update Diário de Coleta " & ThisWorkbook.Sheets("Calc Proj").Range("b1").Value &
.cc = ""
.BCC = ""
.Subject = "Paciente Auto Risco - " & Plan4.Cells(linha, 3) & " - " & Plan4.Cells(linha, 2) & " - " & Plan4.Cells(linha, 1)
.HTMLBody = HTML
.Display 'Utilize Send para enviar o email sem abrir o Outlook
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End If

End Sub

Desde ja agradeço a todos, Jonatas

 
Postado : 03/05/2016 5:37 pm
(@adgere)
Posts: 0
New Member
 

Fiz pequenas alterações na estrutura.. veja se funciona..

Private Sub Worksheet_Change(ByVal Target As Range)

Dim OutApp As Object
Dim OutMail As Object
Dim texto As String

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

linha = Target.Row
If Target.Address = "$F$" & linha Then

    If Plan1.Cells(linha, 6) = "SIM" Then

        HTML = HTML & "<head>"
        HTML = HTML & "<body>"
        HTML = HTML & "<font size='2' font color= #333333 face='Arial Unicode MS'>Caros, " & cliente & "</b></font></br>" '<b> é bold. <i> é itálico
        HTML = HTML & "<br>" 'Equivalente ao enter
        HTML = HTML & "<br>"

        HTML = HTML & "</body>"
        HTML = HTML & "</html>"

        With OutMail
            .To = Plan4.Cells(linha, 7)
            '"Update Diário de Coleta " & ThisWorkbook.Sheets("Calc Proj").Range("b1").Value &
            .cc = ""
            .BCC = ""
            .Subject = "Paciente Auto Risco - " & Plan4.Cells(linha, 3) & " - " & Plan4.Cells(linha, 2) & " - " & Plan4.Cells(linha, 1)
            .HTMLBody = HTML
            .Display 'Utilize Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0

    End If

End If

Set OutMail = Nothing
Set OutApp = Nothing

End Sub
 
Postado : 03/05/2016 7:13 pm
(@jmadao)
Posts: 0
New Member
Topic starter
 

AdGere, bom dia
Tentei a sua estrutura, porem nao surtiu efeito, mesmo escrevendo "sim" ou utilizando a formula "SE" com retorno de "SIM", nao funciona.
Copiei a sua estrutura e coloquei por cima da minha, mais sem solução.

 
Postado : 04/05/2016 6:15 am
(@mprudencio)
Posts: 0
New Member
 

No codigo do adGere

Troque essa linha

If Plan1.Cells(linha, 6) = "SIM" Then

Por esta

If Plan1.Cells(linha, 6).Value = "SIM" Then

O destaque em negrito é apenas para identificar a alteração

 
Postado : 04/05/2016 6:54 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

MPrudencio,
Mesmo alterando de If Plan1.Cells(linha, 6) = "SIM" Then para If Plan1.Cells(linha, 6).Value = "SIM" Then, nao surtiu efeito.

A estrutura que estou utilizando ela funciona apenas se eu escrever "SIM", se eu deixar a formula automatica nao reconhece.
Com a estrutura do AdGere, nao funciona nem escrevendo "SIM".

 
Postado : 04/05/2016 7:16 am
(@mprudencio)
Posts: 0
New Member
 

Verifique se na formula qdo retorna SIM é exibido DA MESMA FORMA QUE NO VBA.

Desconfio que na formula vc deve ter Sim e no VBA esta SIM

Isso em VBA é DIFERENTE.

 
Postado : 04/05/2016 7:21 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

Mprudencio,
A VBA esta SIM, maiusculo.

Se eu escrever sim ou SIM de forma manual o email funciona, a VBA nao esta fazendo destinção

 
Postado : 04/05/2016 8:02 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se entendi, está querendo executar uma rotina conforme o resultado de uma formula assim que a mesma for alterada, se for isto o correto é no Evento Calculate.
O ideal seria anexar seu modelo para uma analise melhor, mas tente seguir a execução da rotina Passo a Passo, posicione o cursor em cima da linha "Private Sub Worksheet_Change(ByVal Target As Range)" e pressione "F9" a mesma ficará na cor Marrom, volte a planilha e faça o procedimento normal, assim que alterar a janela do VBE abrirá e a linha em marrom estará selecionada em amarelo, então vá pressionando "F8" e verá passo a passo a execução da rotina e conseguirá ver os valores das variáveis e tambem o porque ela está pulando as condições .

[]s

 
Postado : 04/05/2016 8:18 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

Mauro, bom dia
O seu entendimento é isso mesmo, tenho uma formula pronta na coluna "F", porem o VBA nao executa pela formula , so executa se eu escrever manualmente.
Estou enviando o link da planilha, se conseguir me ajudar fico muito agradecido.

link https://we.tl/7Deza72wb8

 
Postado : 04/05/2016 8:30 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Você fez os passos que indiquei ?

Não tenho acesso a drivers virtuais, anexe seu modelo aqui mesmo conforme as regras do forum
Como Anexar Aquivos Compactados ?
viewtopic.php?f=7&t=3841

 
Postado : 04/05/2016 8:37 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

.

 
Postado : 04/05/2016 8:57 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

Mauro,
Vou fazer suas orientações na hora do meu almoço que tenho um tempinho extra.
segui o passo a passo viewtopic.php?f=7&t=3841 para inserir a palnilha porem nao vai, ela tem 8 megas sera isso?

 
Postado : 04/05/2016 8:59 am
(@adgere)
Posts: 0
New Member
 

Seguindo a linha do MPrudencio...

Troque essa linha

If Plan1.Cells(linha, 6) = "SIM" Then

Por esta

If Plan1.Cells(linha, 6).Text= "SIM" Then

 
Postado : 04/05/2016 9:16 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

Adgere,
Mudei a linha e mesmo assim não fica automatico, apenas manual

 
Postado : 04/05/2016 9:32 am
(@jmadao)
Posts: 0
New Member
Topic starter
 

Mauro,
Fiz as usas orientações, se eu escrever SIM, e ir apertando F8 nao da erro algum conclui o VBA todo.
Agora nao consigo fazer o F8 se eu nao escrever sim. So de forma manual

 
Postado : 04/05/2016 9:37 am
Página 1 / 3