Planilha que envia email baseado em data

[Brun00_]

Não tenho mais sua planilha, seria possível mandar no sendspace.com ? faço para você com o envio das datas quando for igual ao dia de envio.

 

 

Falou

[Visitante]

@victor

Experimente após substituir estas linhas

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

por estas

If Not IsNumeric(Application.Match(Target.Column, _                Array(8, 11, 13, 15, 17, 19, 21, 23, 25, 27), 0)) Then Exit SubIf Target.Value = Date Thenlinha = Target.Row

lembrete - atalho de teclado para inserir a data do dia >> Ctrl + ;
 

[victorrgds]

Osvaldo, obrigado...a principio deu certo, porém gostaria de tirar uma dúvida...rs

 

Com a planilha fechada, os emails também são disparados?

 

Uma coisa que eu reparei, talvez seja gazelada minha...mas eu inseri a data 21/02/2014 e o email foi disparado hoje pra mim. Será que gazelei?

 

A outra dúvida é se tem algum problema todas as datas que eu tenho como "previsão" de disparar o email já serem inseridas na planilha, por que são datas baseadas em cronograma, ou seja, eu já deixo inseridas várias datas nas colunas.

 

Abs e obrigado pela prontidão.

[Visitante]

Com a planilha fechada, os emails também são disparados?

Imagino que você quis dizer com o arquivo fechado.

Desconheço algum comando nativo do Excel que faça isso. Há no mercado programas pagos que trabalham no arquivo fechado.

 

Uma coisa que eu reparei, talvez seja gazelada minha...mas eu inseri a data 21/02/2014 e o email foi disparado hoje pra mim. Será que gazelei?

Só dispararia se o calendário da sua máquina estiver adiantado e apontando 21/2/14.

 

A outra dúvida é se tem algum problema todas as datas que eu tenho como "previsão" de disparar o email já serem inseridas na planilha, por que são datas baseadas em cronograma, ou seja, eu já deixo inseridas várias datas nas colunas.

O código só vai enviar mensagem se for inserida a data do dia. Não irá rodar se inserir datas futuras.

Mas há alternativas, mantendo o código que funcionou:

    1. colocar um código no evento Workbook_Open que, ao abrir o arquivo, verifica as datas e envia as mensagens correspondentes à data do dia.

    2. além do descrito acima, se quiser automatizar um pouco mais, pode programar via Windows a abertura do arquivo todos os dias em certo horário.

 

 

Continuo intrigado com este comando que está no seu código original  linha = ActiveCell.Row - 1

No último código que você disse que "a principio deu certo", acrescente o -1 e nos diga o resultado, por favor.

[Brun00_]

Isso só vai fazer o valor da variável linha diminuir 1 (óbvio) se ele estiver ativado na célula F5 ele vai enviar os dados referente a célula F4, no caso dele não precisa do -1, na verdade utilizar o ActiveCell para este fim é a pior coisa do mundo, pois só vai enviar o email se você clicar na linha que for enviar....

[Visitante]

Isso só vai fazer o valor da variável linha diminuir 1 (óbvio) se ele estiver ativado na célula F5 ele vai enviar os dados referente a célula F4, no caso dele não precisa do -1, na verdade utilizar o ActiveCell para este fim é a pior coisa do mundo, pois só vai enviar o email se você clicar na linha que for enviar....

Eu escrevi que estou intrigado com o comando ter funcionado. Eu não escrevi que não sei interpretar o comando.

 

Ainda, a mensagem que postei foi endereçada ao Victor.

 

[Brun00_]

Calma amigo, ta nervoso? Se a conversa fosse só para ele ler poderia ter enviado uma MP, o código funciona, mas provavelmente o amigo Victor não deve ter percebido que enviou o email com a linha de cima e não a que estava ativada.

 

Pode ficar tranquilo não vou mais atrapalhar o "Tópico de vocês".

[victorrgds]

Calma galera, a ideia aqui é encontrarmos uma melhor maneira de solucionar isso, sem discussões...

 

Estou pesquisando essa parte de programar o windows para abrir a planilha todo dia e consequentemente disparar email caso o dia que for aberto tiver algum informe necessário...

[victorrgds]

O código só vai enviar mensagem se for inserida a data do dia. Não irá rodar se inserir datas futuras.

Mas há alternativas, mantendo o código que funcionou:

    1. colocar um código no evento Workbook_Open que, ao abrir o arquivo, verifica as datas e envia as mensagens correspondentes à data do dia.

 

Osvaldo, como seria esse código?

 

abs,

[Visitante]

Testaí, Victor.

Instale o código abaixo no módulo de EstaPasta_de_trabalho, assim:
1. copie o código daqui
2. a partir de qualquer planilha tecle 'Alt+F11' para acessar o editor de VBA
3. no lado esquerdo da tela dê duplo clique em  EstaPasta_de_trabalho
4. cole o código na janela em branco que vai se abrir
5. feito! 'Alt+Q' para retornar para a planilha e testar

Salve, feche e reabra o arquivo para testar.
 

Private Sub Workbook_Open()    Dim OutApp As Object    Dim OutMail As Object    Dim texto As String    Dim frsData As String, rngData As Range, k As Long, addK As Boolean    Dim linha As Long, msg As Long        Set OutApp = CreateObject("Outlook.Application")k = 8Do  Set rngData = Sheets("Plan1").Columns(k).Find(Date, LookIn:=xlValues)  If Not rngData Is Nothing Then      frsData = rngData.Address      linha = rngData.Row      Do        If Sheets("Plan1").Cells(linha, 6).Value = "Concluído" And rngData.Interior.ColorIndex <> 6 Then            texto = "Prezado(a) " & Sheets("Plan1").Cells(linha, 1) & "," & vbCrLf & vbCrLf & _                    "A Fase de " & Sheets("Plan1").Cells(linha, 3) & " foi concluída " & _                    Sheets("Plan1").Cells(linha, 2) & vbCrLf & _                    " Veja informações abaixo:" & vbCrLf & _                    "    Projeto: AXXPXXX" & vbCrLf & _                    "    Status: " & Sheets("Plan1").Cells(linha, 6) & vbCrLf & _                    "    Próxima fase: " & Sheets("Plan1").Cells(linha, 5) & vbCrLf & vbCrLf & _                    "Atenciosamente," & vbCrLf & _                    "Qualidade e Metodologia"          Set OutMail = OutApp.CreateItem(0)          With OutMail            .To = Sheets("Plan1").Cells(linha, 1).Value            .CC = ""            .BCC = ""            .Subject = "Informe de Projeto"            .Body = texto            .Send  'Utilize Send para enviar o email sem abrir o Outlook          End With            msg = msg + 1            rngData.Interior.ColorIndex = 6        End If            Set rngData = Sheets("Plan1").Columns(k).FindNext(rngData)            linha = rngData.Row           Loop While Not rngData Is Nothing And rngData.Address <> frsDataEnd IfIf addK Then k = k + 2 Else: k = k + 3addK = TrueLoop While k < 27MsgBox "enviadas " & msg & " mensagens"End Sub

[victorrgds]

Fala Osvaldo, tudo bem?

 

Perfeito cara, porém tentei passar pra planilha que eu vou usar, aquela que mandei o link la atrás, adaptei o código e etc, só que o email não foi disparado...

 

vou te passar o código pra você analisar:

Private Sub Workbook_Open()    Dim OutApp As Object    Dim OutMail As Object    Dim texto As String    Dim frsData As String, rngData As Range, k As Long, addK As Boolean    Dim linha As Long, msg As Long        Set OutApp = CreateObject("Outlook.Application")k = 8Do  Set rngData = Sheets("Plan3").Columns(k).Find(Date, LookIn:=xlValues)  If Not rngData Is Nothing Then      frsData = rngData.Address      linha = rngData.Row      Do        If Sheets("Plan3").Cells(linha, 6).Value = "Concluído" And rngData.Interior.ColorIndex <> 6 Then            texto = "Prezado(a) " & Sheets("Plan3").Cells(linha, 1) & "," & vbCrLf & vbCrLf & _                    "A Fase de " & Sheets("Plan3").Cells(linha, 6) & " do projeto " & Sheets("Plan3").Cells(linha, 2)" foi concluída " & _                    Sheets("Plan3").Cells(linha, 2) & vbCrLf & _                    "Qualidade e Metodologia"                    Set OutMail = OutApp.CreateItem(0)          With OutMail            .To = Sheets("Plan3").Cells(linha, 1).Value            .CC = ""            .BCC = ""            .Subject = "Informe de Projeto"            .Body = texto            .Send  'Utilize Send para enviar o email sem abrir o Outlook          End With            msg = msg + 1            rngData.Interior.ColorIndex = 6        End If            Set rngData = Sheets("Plan3").Columns(k).FindNext(rngData)            linha = rngData.Row           Loop While Not rngData Is Nothing And rngData.Address <> frsDataEnd IfIf addK Then k = k + 2 Else: k = k + 3addK = TrueLoop While k < 27MsgBox "enviadas " & msg & " mensagens"End Sub

Caso tenha algum erro grotesco peço que releve, to pegando o jeito de VBA ainda...

 

abs

[Visitante]

Além de alterar de Plan1 para Plan3 o que mais você alterou no código?

 

Em qual post está o link para o seu arquivo?

[victorrgds]

http://www.4shared.com/file/L_EvQIWOba/Controle_de_Mapas_Qualitativo.html

Só o plan3 e o texto do email...

Abs

[Visitante]

Se você testou no arquivo do link acima não iria funcionar nunca.

Os critérios abaixo foi você que passou para a montagem dos códigos, no entanto, na sua planilha:

1. na coluna "A" você não colocou endereços válidos de e-mail

2. na coluna "H" você não colocou datas, colocou valores em moeda

3. nas demais colunas de busca não encontrei nenhuma célula com a data de hoje

4. na coluna "F" não há nenhuma célula preenchida com a palavra "Concluído"...

 

Ainda, no arquivo do link não há códigos instalados (???), e o nome da guia da planilha é diferente no nome da planilha que está no último código que você postou (???).

 

Nessas condições,  que tipo de teste você fez ?

Você precisa fazer a sua parte.

Faça as correções que o código vai funcionar!

[victorrgds]

Fala Osvaldo, beleza?

 

Eu vi o arquivo que te mandei o link agora, realmente está sem as alterações necessárias...(versão errada)

 

Mas no caso 1, tem emails.

 

Sobre a coluna "H", eu achava que independente da coluna que a data fosse inserida o email seria disparado...

 

Realmente havia algumas datas antigas (devido ser uma versão incorreta do planilha)

 

Pra finalizar, segue o link da versão correta: http://www.sendspace.com/file/g658kc

 

Abs,

Na versão correta tem a coluna F com os status.

[victorrgds]

Segue o código que eu inseri na planilha que te passei osvaldo:

Private Sub Workbook_Open()    Dim OutApp As Object    Dim OutMail As Object    Dim texto As String    Dim frsData As String, rngData As Range, k As Long, addK As Boolean    Dim linha As Long, msg As Long        Set OutApp = CreateObject("Outlook.Application")k = 10Do  Set rngData = Sheets("Plan3").Columns(k).Find(Date, LookIn:=xlValues)  If Not rngData Is Nothing Then      frsData = rngData.Address      linha = rngData.Row      Do        If Sheets("Plan3").Cells(linha, 6).Value = "Concluído" And rngData.Interior.ColorIndex <> 6 Then            texto = "Prezado(a) " & Plan3.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _                    "Qualidade e Metodologia"                    Set OutMail = OutApp.CreateItem(0)          With OutMail            .To = Sheets("Plan3").Cells(linha, 1).Value            .CC = ""            .BCC = ""            .Subject = "Informe de Projeto"            .Body = texto            .Send  'Utilize Send para enviar o email sem abrir o Outlook          End With            msg = msg + 1            rngData.Interior.ColorIndex = 6        End If            Set rngData = Sheets("Plan3").Columns(k).FindNext(rngData)            linha = rngData.Row           Loop While Not rngData Is Nothing And rngData.Address <> frsDataEnd IfIf addK Then k = k + 2 Else: k = k + 3addK = TrueLoop While k < 27MsgBox "enviadas " & msg & " mensagens"End Sub

Não to conseguindo identificar o porque não envia o email...

 

Abs,

[victorrgds]

Galera, caso resolvido...

 

após algumas mudanças no código está tudo funcionando.

 

Estou disponibilizando o código para alguem que precise futuramente, comentadinho e tudo mais...

Private Sub Workbook_Open()    Dim OutApp As Object    Dim OutMail As Object    Dim texto As String    Dim frsData As String, rngData As Range, k As Long, addK As Boolean    Dim linha As Long, msg As Long    Set OutApp = CreateObject("Outlook.Application")k = 10 'coluna que inicia a contagemDo  Set rngData = Sheets("Projetos").Columns(k).Find(Date, LookIn:=xlValues)    If Not rngData Is Nothing Then      frsData = rngData.Address      linha = rngData.Row      Do        If rngData.Interior.ColorIndex <> 6 Then 'compara se a cor da célula é branca ou amarela para disparar o email            'texto = "Prezado(a) " & Projetos.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _                    '"Qualidade e Metodologia"                    Set OutMail = OutApp.CreateItem(0)          With OutMail            .To = "[email protected]" 'Sheets("Projetos").Cells(linha, 1).Value            .CC = ""            .BCC = ""            .Subject = "Informe de Projeto"            .Body = "Teste de informe"            .Send  'Utilize Send para enviar o email sem abrir o Outlook          End With            msg = msg + 1            rngData.Interior.ColorIndex = 6 'pinta a celula com a data = hj de amarelo para não reenviar o email após reabrir a planilha         End If            Set rngData = Sheets("Projetos").Columns(k).FindNext(rngData)            linha = rngData.Row           Loop While Not rngData Is Nothing And rngData.Address <> frsData   End If'If addK Then k = k + 2 Else: k = k + 3'addK = True    k = k + 2Loop While k < 31 'ultima coluna que contem datas e será o limite da verificaçãoMsgBox "enviadas " & msg & " mensagens"End Sub

Gostaria de agradecer ao Osvaldo, que foi crucial na solução desse problema. Muito obrigado Osvaldo.

 

Abs,