Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Email por Macro não...
 
Notifications
Clear all

Email por Macro não Funciona Worksheet_change

 
Página 3 / 3
2024 - VBA & Macros
Post Recente por jmadao 8 anos atrás
43 Posts
4 Usuários
0 Reactions
5,204 Visualizações
RSS
 jmadao
(@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
 jmadao
(@jmadao)
Posts: 0
New Member
Topic starter
 

Mauro,
Beleza vou esquecer, rs eventos manuais.

O loop, é via conexão de dados do SQL Server, do próprio excel.
"Você não respondeu quanto a questão das repetições apos atualizações." Referente esta pergunta não entendi muito bem, mais vou tentar ser o mais claro possível, para que vocês possam me ajudar.
A minha ideia, que a cada 20min. caso tenha uma autualização com SIM(verdadeira), envie um e-mail referente aquela nova linha que foi atualizada. As demais linha que ja foram atualizadas, nao precisa reenviar email.

Meu cronograma seria: A planilha rodar sozinha todos os dias, quando verificasse o valor "SIM" mandasse email. De acordo com tempo de execução de atualização. Porem mandasse apenas os emails de novas atualizações. Ex: Hj 05/05 tivemos um caso com sim, o email ativa. Amanha 06/05 nao tiver nehuma nao envia nada, ou se tiver envia apenas os pacientes do dia 06/05.

Abri o filtro da tabela dinamica e coloquei no sendspcace: https://www.sendspace.com/file/ax9jlq

 
Postado : 05/05/2016 9:36 am
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Kd a base de dados geradora da Tabela Dinamica.

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

Marcelo,
A base de dados esta no servidor, eu ja atualizo a mesma através de tabela dinâmica. Nao carrego analítico, porque o arquivo fica pesado.
Precisa que abro o analítico? se quiser posso abrir.

No aguardo

 
Postado : 05/05/2016 11:03 am
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Ela é necessaria para testes...

Nem precisa de ser completa

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

Marcelo,
Consegui subir a planilha aqui com banco de dados.
A celula F10, esta sem formula pelo fato que estava testando o "SIM" de forma manual. o restante esta com formulas.

 
Postado : 05/05/2016 12:13 pm
 jmadao
(@jmadao)
Posts: 0
New Member
Topic starter
 

Segue a planilha

 
Postado : 05/05/2016 12:19 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Eu nao tenho como testar entao faça os testes tudo indica que deve funcionar

 
Postado : 05/05/2016 12:46 pm
 jmadao
(@jmadao)
Posts: 0
New Member
Topic starter
 

Marcelo,
Obrigado pela atenção, porem esta gerando erro: Erro de compilação Else sem If neste ponto
MsgBox "Funcionou"

linha = linha + 1

Else

linha = linha + 1

Vejo que colou uma caixa de mensagem de funcionou, porem nao roda.

 
Postado : 05/05/2016 1:13 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Troque o codigo da planilha por este:


Private Sub Worksheet_change(ByVal Target As Range)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
     Dim linha As Long
     Dim ulinha As Long
     
     

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

    linha = 10
    ulinha = Plan1.Range("F" & Rows.Count).End(xlUp).Row


For A = linha To ulinha

   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 & "<font size='2' font color= #333333 face='Arial Unicode MS'>O Paciente <b>" & Plan1.Cells(linha, 8) & "</b>"
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial Unicode MS'>O valor é de: <b>" & Plan1.Cells(linha, 10) & "</b>"
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial Unicode MS'>Este paciente esta internado <b>" & Plan1.Cells(linha, 2) & "</b>"
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial Unicode MS'>Sera necessario acompanhar este paciente de perto."
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #b20000 face='Arial'><b>Gerencia"
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial'></b>Faturamento"
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial'>Fixo : +55 (16)    3434 2999  "
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #333333 face='Arial'>Cel. : +55 (16) 9 9352 9972 "
HTML = HTML & "<br>"
HTML = HTML & "<font size='2' font color= #327eff face='Arial'><u>www.facebook.com/doesangue.gsh  "
HTML = HTML & "<br>"
HTML = HTML & "</body>"
HTML = HTML & "</html>"

        With OutMail
            .To = Plan1.Cells(linha, 7)
            '"Update Diário de Coleta " & ThisWorkbook.Sheets("Calc Proj").Range("b1").Value &
            .cc = ""
            .BCC = ""
            .Subject = "Paciente Auto Risco - " & Plan1.Cells(linha, 3) & " - " & Plan1.Cells(linha, 2) & " - " & Plan1.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

    linha = linha + 1

    Else

    linha = linha + 1

    End If

Next

End Sub

Aplique a formula na coluna F

 
Postado : 05/05/2016 1:26 pm
 jmadao
(@jmadao)
Posts: 0
New Member
Topic starter
 

Marcelo,
Sua VBA deu certo de ficar automática.
Porem a VBA enxerga sempre o primeiro "SIM". Ex: se eu tiver um "SIM" na F10 e aprece mais um sim F15 a macro ativa com dados da F10.
Agora se não tiver nenhum "SIM" antes da F15, carrega os dados da F15

 
Postado : 05/05/2016 1:50 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Como eu disse nao tenho como testar mas analisando o codigo nao vi nenhum erro que fosse responsavel pelo problema relatado por vc, uma vez que o codigo pula uma linha apos o envio ou uma linha caso a condição if seja falsa, entao nao deveria causar esse problema ja que aparentemente os dados sao carregados de acordo com o numero da linha.

Tente depurar o codigo e na parte do envio verifique a informação que aparece em cada linha

 
Postado : 05/05/2016 2:41 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Verifique os valores de cada email pois é a unica coisa que muda na tabela

 
Postado : 05/05/2016 3:04 pm
 jmadao
(@jmadao)
Posts: 0
New Member
Topic starter
 

Marcelo,
Antes de mencionar o acontecimento eu depurei, a VBA corre sem erros.
O teste que eu fiz foi:
Tirei todo filtro imaginando que não temos nenhum paciente no critério de 4000. Depois fui e selecionei apenas um OTTONI PIFFERO MONTEIRO, como se fosse a atualização trouxesse apenas um paciente com maior de 4000, a vba correu perfeita quanto na depuração e o e-mail abriu automático. Show de bola era isso mesmo que queria.
Ai oque eu fiz, deixei o OTTONI PIFFERO MONTEIRO, filtrado como se fosse o histórico e filtrei mais um paciente VAGNER GOMES DO NASCIMENTO, como se fosse o segundo paciente a entrar no critério. Lembrando q o 1° paciente ja estava filtrado e a linha 10, nao sofreu alteração. Ao incluir o VAGNER GOMES DO NASCIMENTO, a vba correu sem erro abriu o e-mail automático so que trouxe os dados da linha 10 nao da 11 que seria o novo paciente.(novo historico)

 
Postado : 05/05/2016 3:20 pm
Página 3 / 3
Forum Jump:
  Tópico Anterior
Próximo Tópico