Aviso pelo Outlook

Amigo possuo um formulário ordenado por um campo de Data chamado "Validade" e outro texto chamado "SITUAÇÃO". O campo situação está programado para ficar em vermelho e escrito CALIBRAR assim que o Campo "Validade" seja = a 30 dias antes da data atual.

Gostaria que além disso, quando o campo Validade atingir 30 dias antes da data atual fosse enviado um aviso através de Outlook, por email ou por lembrete não sei qual seria a possibilidade!

Amigos, há algum comando para esse fim?

Muito obrigado desde já!

Abaixo os comandos mais relevantes que já estão implementados!

Private Sub Comando24_Click()

If DCount("*", "Equipamentos", "[Validade]-30> [DATA]") > 0 Then DoCmd.OpenForm "OK"

End Sub

Private Sub Comando24_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If DCount("*", "Equipamentos", "[Validade]-30<= [DATA]") > 0 Then DoCmd.OpenForm "Vencido"

End Sub

Private Sub Form_Open(Cancel As Integer)

Me.OrderBy = "validade"
Me.OrderByOn = True

End Sub

Uma forma interessante de se fazer isso seria enviando o email via cdo, que é um componente, uma dll, que possibilita essa façanha no Access mesmo que não tenha nenhum cliente de email instalado no programa. procure por cdo aqui no forum que tem algumas coisas, inclusive exemplos no Repositório de Exemplos. Qualquer coisa, retorne.

Então, abri este exemplo que você postou no repositório...

http://dl.dropbox.com/u/5454503/EmailCDO.zip
--------------------------------------------

Diga se entendi corretamente. Eu teria criar um sistema de envio de Email no meu programinha para poder fazer os envios automáticos?

Pq se for isso acho que meu nível ainda não chegou nesse patamar

Ou não preciso fazer todo o sistema?

Ultima pergunta, há outra alternativa mais simples?

Obrigado mais uma vez!!!

Alguma boa alma por favor

Estou meio ocupado para procurar algo aqui agora. Assim que estiver mais folgado eu posto alguma coisa, caso alguem não o faça antes.

Desculpe a insistencia! Só me diga se entendi corretamente. Eu teria criar um sistema de envio de Email no meu programinha para poder fazer os envios automáticos?

Ou não é preciso fazer todo o sistema, há alguma alternativa mais simples algum comando algo do tipo!?

Vou passar uma forma de se fazer isso. Coloque a função abaixo no cabeçalho do módulo vba do seu formulário logo abaixo da linha Option Compare Database:

Sub EnviarEmail()

On Error GoTo TErro

Dim Mens As Object
Dim Config As Object
Set Mens = CreateObject("CDO.Message")
Set Config = CreateObject("CDO.Configuration")

With Config

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "usuario@gmail.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SuaSenha"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update
End With

Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = "Seu nome aqui"

.Sender = "Seu email"

.ReplyTo = "Email de resposta"

.BodyPart.Charset = "utf-8"

.Subject = "Assunto"

.HTMLBody = "Aqui a mensagem a ser enviada."

End If

.To = rs!CampoDoEmail

End With

Set Mens = Nothing
Set Config = Nothing

TErro:
If Err.Number = 13 Then
Resume Next
ElseIf Err.Number = -2147220979 Then
DoCmd.Close acForm, "frmProgresso"
MsgBox "Você inseriu um endereço de email inválido ou inexistente." & vbCrLf & "Verifique o email e tente novamente.", vbOKOnly + vbCritical, "Email inválido"
DoCmd.Close acForm, "frmFinalizar"
Me.txtPara.SetFocus
Else
Resume Next
End If

End Sub

Agora, no evento "Ao carregar" do formulário, iremos abrir um Recordset filtrado pelo intervalo de data pretendido. Será feita uma pesquisa na tabela, nos registros que satisfaçam esse intervalo. Se o total de registro for maior que zero, será enviado um email a todos os encontrados:

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT CampoDoEmail FROM NomeDaTabela WHERE CampoDaData='" & DateAdd("d", -30, Date) & "'")

If rs.RecorCount > 0 Then

Do While Not rs.EOF
Call EnviarEmail
rs.MoveNext
Loop

Else
End If

rs.Close
Set rs = Nothing

Observe os nomes em vermelho. Eles deverão ser alterados de acordo o provedor do seu email. Aqui tem dicas de como fazer isso. Os campos em verde será aonde você colocará os dados a serem enviados, elem de outros detalhes para os quais tambem contem dica no endereço do link acima.

OBS.: O sistema fica aberto ou será aberto todos os dias, incluindo sábados, domingos e feriados? Porque se ele ficar sem ser aberto em algum dia, terá que mudar um pouquinho o esquema, criando um campo na tabela para dizer se o email já foi enviado ou não, para quando abrir, depois dos 30 dias ou faltando uns 3 dias para completar, por exemplo, saber para quem deveria ter sido enviado mais ainda não foi. Tambem seria interessante incluir uma função para checar se a net está conectada ou não. Senão coloca como enviado sem ter sido, caso a net esteja fora do ar.

Bom dia amigo Criquio!! que beleza de tutorial ein!
Agora me empolguei para implementar isso! Vou ler direitinho aquele tutorial do link que vc postou ai!
Parabéns pelo trabalho ainda não li mas deu pra ver por cima que foi mto bem feito!

Obrigado!
Quando eu conseguir terminar de implementar coloco como resolvido!
Tenha um bom dia!

Criquio implementei os códigos!!

Na Depuração está ocorrendo o seguinte erro:

Erro de compilação:

O tipo definido pelo usuário não foi definido!

Mostrando a linha "New CDO.Message!" em destaque e a linha ".to andre.rosanti@xxx.com.br" em vermelho, do jeito que eu coloquei abaixo!

O que deve ser amigo?

PS: Com relação as questões suas:

1 - O sisteminha não vai ser aberto todos os dias, vou criar um campo então chamado "Emai-l" para verificar se foi enviado ou não!

2 - O Email só vai ser enviado no caso para uma pessoa e realmente as vezes a net está off aqui!

===============================================================
Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = "André L. Rosanti"

.Sender = "andre.rosanti@xxx.com.br"

.BodyPart.Charset = "utf-8"

.Subject = "Certificado com validade Vencendo"

.TextBody = "Por favor, verifique os seus certificados através do sistema de gestão!"

End If
.To = rs!andre.rosanti@xxx.com.br

End With.

Entre em módulo qualquer, vá no meu Ferramentas > Referências e marque a referência "Microsoft CDO for Windows 2000 Library"

ja tentei isso criquio esta dando erro ao acessar os registros do sistema!

E que erro que dá? Sempre que der erro informe qual é e o que acontece depois para podermos ter uma ideia do que possa estar acontecendo.

Criquio da esse erro que sitei na msg de cima!

Quando acesso a página de códigos do VB e tento ir em Referências no menu Ferramentas ocorre o seguinte erro:

"Erro ao acessar os registros do sistema!"

Busquei algumas soluções na net mas não consegui, uma diz para eu abrir o RegMon no site da systernals para ver qual chave está com problema, mas infelizmente ele esta bloqueado aqui....

agora fiquei sem saber como corrigir, alguma sugestão amigo!?

Isso está com cara de registro corrompido ou de acesso negado mesmo. Qual é a versão do Windows? Talvez seja necessário alterar as permissões de acesso, ou, se for registro corrompido e dependendo da versão de Windows, possa fazer uma instalação em modo de recuperação.

Microsoft Windows XP Professional
Versão 2002
Service Pack 3

-----

Tá osso Criquio... estou a vários dias aqui enxendo o saco do pessoal da informática da empresa e nada, já fizeram recuperação do access, do office, já sai do office 2007 pro 2010 já testei em outras 2 maquinas e da o mesmo erro, só não deu erro na maquina do cara lá na informática mesmo! Lá entrei bunitinho nas referencias ativei o Microsoft CDO sem problema nenhum..... agora o cara da informática daqui só sabe falar em formatar.... po testei em mais 2 maquinas além da minha e deu a mesma coisa, será que formatar vai resolver algo!? eu estou achando que vai ser só perca de tempo.....

Como vc mesmo disse e eu já falei pra eles, isso parece registro corrompido ou de acesso bloqueado, mas segundo o pessoal da inf. aqui tem acesso...

já não sei o que fazer.... baixei até o regmon e tentei olhar alguns registros que aparece como not found e colocar acesso pra meu usuario mas não resolveu!!

To quase desistindo =/]

Será que a versão do windows tem algo a ver?

Aí fica meio complicado dar mais opiniões sem estar de corpo presente na cena do acontecido. Espero que encontres uma saída.

Tópico Resolvido

Amigo Criquio, estou reabrindo este tópico, pois, na época tinha desistido de implementar por não estar conseguindo acessar as referências, mas agora já não tenho mais esse problema então estou tentando implementar o código para envio de email via CDO, sei que faz tempo mas tomara que você ou outro membro ainda possa me ajudar.

Coloquei todo o código e preenchi de acordo com o que você passou, agora estou tendo um problema nesta parte do código, mais especificamente no CampoDoEmail, pois, no NomeDaTabela e no CampoDaData tudo bem sei o que colocar, mas no CampoDoEmail não sei e quando carrego o formulário ativando assim o código da o seguinte erro:

Erro em tempo de execução '3061':
Parâmetros insuficientes. Eram esperados 1.

O que pode estar ocorrendo amigo?

Agradeço a atenção desde já!

abaixo está a parte do código que vai no evento ao carregar do formulário da forma que eu coloquei.
Private Sub Form_Load()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT CampoDoEmail (qual campo seria?) FROM Equipamentos WHERE UltimaCalibracao='" & DateAdd("d", -30, Date) & "'")

If rs.RecordCount > 0 Then
Do While Not rs.EOF
Call EnviarEmail
rs.MoveNext
Loop

Else
End If
rs.Close
Set rs = Nothing
End Sub


Agora abaixo segue como coloquei o código no cabeçalho abaixo de Option Compare Database:

Sub EnviarEmail()

On Error GoTo TErro

Dim Mens As Object
Dim Config As Object
Set Mens = CreateObject("CDO.Message")
Set Config = CreateObject("CDO.Configuration")

With Config
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.ajax.com.br"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 110
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "andre.rosanti@ajax.com.br"
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "lke2574"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Fields.Update
End With

Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = "LA Manager Notification!"
.Sender = "andre.rosanti@ajax.com.br"
.CC = "caio.hayasaka@ajax.com.br"
.BodyPart.Charset = "utf-8"
.Subject = "Certificado Vencido"
.HTMLBody = "Existem certificados a serem verificados!"
.To = "andre.rosanti@ajax.com.br"
.Send
End With

Set Mens = Nothing
Set Config = Nothing

TErro:
If Err.Number = 13 Then
Resume Next
ElseIf Err.Number = -2147220979 Then
MsgBox "Você inseriu um endereço de email inválido ou inexistente." & vbCrLf & "Verifique o email e tente novamente.", vbOKOnly + vbCritical, "Email inválido"
Else
Resume Next
End If
End Sub

CampoDoEmail é o campo aonde está o email para o qual a mensagem deve ser enviada.

Certo, adicionei um campo tipo texto na tabela chamado Email com o seguinte valor padrão "andre.rosanti@ajax.com.br" e inseri este campo no rodapé do meu formulário continuo, reescrevi o código e agora está dando o seguinte erro:

Erro em tempo de execução '3064':
Tipo de dados incompatível na expressão de critérios

Será que não pode ter valor padrão?

Abaixo segue o código como ficou

Private Sub Form_Load()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Email FROM Equipamentos WHERE Calibracao='" & DateAdd("d", -30, Date) & "'
If rs.RecordCount > 0 Then
Do While Not rs.EOF
Call EnviarEmail
rs.MoveNext
Loop

Else
End If
rs.Close
Set rs = Nothing
End Sub

O If re.RecordCount > 0 Then está na mesma linha do set rs...? Se tiver, mude para a linha de baixo, fazendo uma quebra de linha.

Tambem tente trocar Calibracao='" & DateAdd("d", -30, Date) & "'") por:

Calibracao=#" & Format(DateAdd("d", -30, Date), "mm/dd/yyyy") & "#")

Fiz as alterações e agora deu o seguinte erro:

Erro em tempo de execução '13':
Tipos incompatíveis

O Código ficou assim:

Private Sub Form_Load()

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Email FROM Equipamentos WHERE Calibracao=#" & Format(DateAdd("d", -30, Date), "mm/dd/yyyy") & "#")

If rs.RecordCount > 0 Then

Do While Not rs.EOF
Call EnviarEmail
rs.MoveNext
Loop

Else
End If

rs.Close
Set rs = Nothing

End Sub

Tente assim:

... WHERE Calibracao LIKE '" & Format(DateAdd("d", -30, Date), "mm/dd/yyyy") & "'"

vai tentando as variações aí. Se não conseguir poste um exemplo para ver se alguem pode dar uma olhada.

Deu o mesmo erro

Erro em tempo de execução '13':
Tipos incompatíveis

Como eu posso variar mais este código?

Amigos, alguém tem mais alguma sugestão, não consegui resolver ainda!