[Resolvido]Envio de mail com consultas agendadas

ola gente amiga
Tenho uma base de dados construída com agendamento de consultas a pacientes onde tenho uma tabela com as marcações (marcacoes) com a data e a hora (campo "data" e campo "hora" e uma tabela de Pacientes (pacientes) com o mail de cada um (campo "mail".
Queria um procedimento que enviasse automaticamente um mail ao paciente com 2 dias de antecedência, relembrando da marcação agendada.
Quem poderá me dar uma ajuda preciosa nisto?
Sei que existem várias duvidas sobre isso já postadas, mas não encontrei nenhuma especifica sobre este assunto, pois preciso que o codigo va automaticamente procurar campos em duas tabelas, e gerar um mail automático com os dados recolhidos.

Agradecia uma ajudada o mais concreta possivel, pois só me falta mesmo este procedimento para terminar o programa.

Abraço a todos e antecipadamente agradecido pelas ajudas que possam me dar.

Olá Tuga,

Veja se o link abaixo atende a sua necessidade.

http://maximoaccess.forumeiros.com/t8506-enviar-email-90-dias-antes-do-vencimento

boas...
ainda antes de testar a questão do mail, preciso de fazer a comparação entre datas. Ou seja, preciso que o codigo vba me compare a data existente na tabela "marcacoes", no campo "Data_M", com a data do sistema e se for uma diferença maior por exemplo a 3 dias, que execute uma função.
Essa função teria que ir na tabela "ficha" do paciente em questão, ver o campo "mail", e selecionar o mesmo para enviar o mail.
Sei que tem varias questões relativas a envio de mail e comparação de datas, mas nao encontrei nenhuma relativa á comparação em numero de dias com a data atual do sistema.
Agradeço todas as ajudas.
Obrigado

Já consegui que um botao de comando ao clicar envie um mail automaticamente pelo outlook, indicando determinado ficheiro a enviar e para qual endereço de mail enviar. este é o código:

Private Sub EnviaMail_Click()
Dim appOutlook As Object
Dim olMail As Object

'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail

With olMail
'On Error Resume Next
.To = "geral@joaquimmartins.net"
.CC = "geral@joaquimmartins.net"
.Subject = "Teste"
.Attachments.Add ("D:\Marcelo\corpo.png")
'.Attachments.Add = ("D:\Marcelo\corpo.png")
.Body = "Bom dia," + vbNewLine + "Segue em anexo relatório de Controle." + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Fulano" + vbNewLine + "Área Comercial"
.Send '.Send
End With
End Sub


Também já consegui fazer uma consulta (Avisa_Marcacao) que filtra os dados que pretendo ( Data da consulta nos proximos 5 dias) e o endereço de mail do paciente para onde enviar o mail.

Agora pretendia anexar ao código acima, para que ao abrir o programa, filtrasse tais dados e fizesse o envio do mail.
Agradeço toda a ajuda possível.
Obrigados

Boa tarde

Para quem precise, já consegui depois de pesquisar bastante, fazer um código que faz parte do que pretendo. No entanto, envia apenas para apenas o primeiro.
Sendo assim precisava de ajuda no código em duas coisas.
1º que enviasse email para todos que encontra com a marcação agendada (Loop deve estar mal configurado;
2º Que enviasse para aqueles cujo campo "notificado" seja "nao" e depois de enviado, marcasse esse campo como "sim"
Eis o código utilizado e a funcionar em parte, pois mesmo, embora faça o envio, dá sempre a seguinte mensagem "Run Time Error - O item foi movido ou eliminado"

Private Sub Comando50_Click()
Dim appOutlook As Object
Dim olMail As Object
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
Set olMail = appOutlook.CreateItem(0)
Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0")
If rs.RecordCount > 0 Then
Do While Not rs.EOF
rs.MoveFirst
Dim EndMail As Variant
Set EndMail = rs!Mail
With olMail
.To = EndMail
.Subject = "Consulta Marcada"
.Body = "Bom dia " & rs!Nome & vbNewLine + "Aproveitamos para relembrar que tem consulta marcada para o dia " & rs!Data_M & " pelas " & rs!Hora_M & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo - FisiOn"
.Send ' envia
rs.MoveNext
End With
Loop
Else
MsgBox ("Sem Marcações a serem notificados.")
End If
End Sub


Agradeço ajuda o mais urgente possivel.

Obrigado

mudei codigo e esta enviando para mais que um contacto.

Também já altera estado para notificado = sim

No entanto só manda para contactos que tenham o mesmo endereço de mail.
E o erro que falei antes... mantem-se!

Private Sub Comando50_Click()
Dim appOutlook As Object
Dim olMail As Object
Dim rs As Recordset
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
Set olMail = appOutlook.CreateItem(0)
Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0")
If rs.RecordCount > 0 Then
Do While Not rs.EOF
rs.MoveFirst
Set EndMail = rs!Mail
With olMail
.To = EndMail
.Subject = "Consulta Marcada"
.Body = "Bom dia " & rs!Nome & vbNewLine + "Aproveitamos para relembrar que tem consulta marcada para o dia " & rs!Data_M & " pelas " & rs!Hora_M & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo - FisiOn"
.Send ' envia
End With
CurrentDb.Execute "UPDATE Avisa_Marcacao SET Notificado=-1 WHERE Cod=" & rs!Cod & ""
rs.MoveNext
Loop
Else
MsgBox ("Sem Marcações a serem notificados.")
End If
End Sub


Alguma ajuda????

Boa tarde

Já consegui... obrigado. Agradeço á unica pessoa que me deu uma dica de exemplo para tentar seguir, no entanto era muito dificil mesmo assim, pois eram campos e objectivos bastante diferentes.

No entanto, contrariamente ao que muitos aqui fazem, mesmo assim deixo aqui o codigo completo, pois pode servir de ajuda a muitos.

Private Sub Comando50_Click()
Dim appOutlook As Object
Dim olMail As Object
Dim rs As Recordset
Dim EndMail As Variant
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
Set olMail = appOutlook.CreateItem(0)
Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0")
If rs.RecordCount > 0 Then
Do While Not rs.EOF
rs.MoveFirst
Set EndMail = rs!Mail
With olMail
.To = EndMail
.Subject = "Consulta Marcada"
.Body = "Bom dia " & rs!Nome & vbNewLine + "Aproveitamos para relembrar que tem consulta marcada para o dia " & rs!Data_M & " pelas " & rs!Hora_M & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo - FisiOn"
.Send ' envia
End With
CurrentDb.Execute "UPDATE Avisa_Marcacao SET Notificado=-1 WHERE Cod=" & rs!Cod & ""
rs.MoveNext
Loop
Else
MsgBox ("Sem Marcações a serem notificados.")
End If
End Sub


Abraço a todos!

Tuga38, boa tarde!

Importante que o problema foi resolvido.


Sucesso!

Preciso reabrir este processo uma vez que esta dando um erro ao abrir o formulario com este procedimento de evento abaixo:


Private Sub Form_Open(Cancel As Integer)
Dim appOutlook As Object
Dim olMail As Object
Dim rs As Recordset
Dim EndMail As Variant
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
Set olMail = appOutlook.CreateItem(0)
Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0")
If rs.RecordCount > 0 Then
Do While Not rs.EOF
rs.MoveFirst
Set EndMail = rs!Mail
With olMail
.To = EndMail
.Subject = "Consulta Marcada"
.Body = "Bom dia " & rs!Nome & vbNewLine + "Aproveitamos para relembrar que tem consulta marcada para o dia " & rs!Data_M & " pelas " & rs!Hora_M & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo - FisiOn"
.Send ' envia
End With
CurrentDb.Execute "UPDATE Avisa_Marcacao SET Notificado=-1 WHERE Cod=" & rs!Cod & ""
rs.MoveNext
Loop
Else
MsgBox ("Sem Marcações a serem notificados.")
End If
End Sub


Aparece uma caixa de mensagem dando "run time error. O item foi movido ou eliminado"
A partir dai ele envia na mesma o mail para aqueles cujo endereço de emai seja igual... e preciso abrir e fechar de novo par ele enviar para os endereços diferentes.

Me dá o erro nesta linha:

.To = EndMail

Alguem saberá o que pode estar acontecendo?

Desde já agradecido
Abraço a todos

Alguma ajuda por favor???

Poucas vezes entrei neste forum, mas esperava uma maior interactividade do mesmo.
Apenas uma pessoa tentou me ajudar com um link para uma duvida parecida, mas que se revelou totalmente inutil, pois a mecanica do problema era totalmente diferente e mesmo depois dos devidos reajustamentos, verifiquei que era completamente inútil.
No entanto, e dado ter verificado que existe uma grande lacuna em termos de exemplos ou resoluções ao que a este problema respeita. não quero deixar de partilhar com todos a solução encontrada e que poderá ajudar muitos programadores em situações idênticas, uma vez que é uma mais valia para um programa com estas características.
Assim, abaixo deixo a resolução do problema, e o código que ficou a funcionar perfeitamente (5 estrelas e exatamente como eu pretendia), depois de horas e horas de buscas pela internet e tentativas e mais tentativas!
Aqui vai e espero que seja util para alguem!


Private Sub Form_Open(Cancel As Integer)
Dim olApp As Object
Dim olMail As Object
Dim rsEmails As DAO.Recordset

Const sSUBJ As String = "Consulta Marcada"
Const sSQL As String = "SELECT [Mail] FROM Avisa_Marcacao;"

Set olApp = GetObject(, "Outlook.Application")
Set rsEmails = CurrentDb.OpenRecordset("Avisa_Marcacao")


Do Until rsEmails.EOF
Set olMailItem = olApp.CreateItem(0)
With olMailItem
.To = rsEmails.Fields("Mail").Value
.Subject = "Consulta Marcada"
.Body = "Bom dia" & vbNewLine + "Exmo (a) Senhor (a)" & vbNewLine & rsEmails.Fields("Nome").Value & vbNewLine + "Relembramos que tem consulta marcada para o dia " & rsEmails.Fields("Data_M").Value & " ás " & rsEmails.Fields("Hora_M").Value & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo|FisiOn"
.Send
End With
rsEmails.MoveNext
Loop
CurrentDb.Execute "UPDATE Avisa_Marcacao SET Notificado=-1 "


End Sub


Abraço a todos!

tuga38,

Estou estudando este mesma função para implementar em meu BD.

Vc tem um arquivo de exemplo de como enviar e-mail para disponibilizar parte dele?

Grato,

Olá
Claro... espero que ajude!!
Demorou muitas horas pesquisando e teria agradecido a mesma ajuda, mas infelizmente ....
Mas nao consigo anexar o ficheiro.
Mande o seu mail e envio por mail
Qualquer coisa mais, avise!
Abraço

O email é wagomes1982@yahoo.com.br

Voce nao tem ideia de como vai me ajudar...Desde ja meu muito obrigado.

Abraço

Enviado.
Bom trabalho

Já consegui tb com código para ignorar outlook fechado, e logo que seja aberto, envia os mails pretendidos.

Eis como fica:

Private Sub Form_Open(Cancel As Integer)

Dim appOutlook As Object
Dim olMail As Object

'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0

Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail

Dim rsEmails As DAO.Recordset

Const sSUBJ As String = "Consulta Marcada"
Const sSQL As String = "SELECT [Mail] FROM Avisa_Marcacao;"


Set rsEmails = CurrentDb.OpenRecordset("Avisa_Marcacao")


Do Until rsEmails.EOF
Set olMailItem = appOutlook.CreateItem(0)
With olMailItem
.To = rsEmails.Fields("Mail").Value
.Subject = "Consulta Marcada"
.Body = "Bom dia" & vbNewLine + "Exmo (a) Senhor (a)" & vbNewLine & rsEmails.Fields("Nome").Value & vbNewLine + "Relembramos que tem consulta marcada para o dia " & rsEmails.Fields("Data_M").Value & " ás " & rsEmails.Fields("Hora_M").Value & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo|FisiOn"
.Send
End With
rsEmails.MoveNext
Loop
CurrentDb.Execute "UPDATE Avisa_Marcacao SET Notificado=-1 "


End Sub

Bom proveito para quem precisar.

Abraços

Ola bom dia !

Eu prefiro assim ao carregar do formulario, mesmo com o Outlook fechado, ele cria uma nova instância;

Código:

Private Sub Form_Load()
    Dim appOutlook As Object
    Dim olMail As Object
   
    'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If appOutlook Is Nothing Then
        Set appOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
   
    Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail
   
Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0")
If rs.RecordCount > 0 Then
Do While Not rs.EOF
rs.MoveFirst
Set EndMail = rs!Mail

With olMail
    .To = EndMail
    .Subject = "Consulta Marcada"
    .Body = "Bom dia " & rs!Nome & vbNewLine & "Aproveitamos para relembrar que tem consulta marcada para o dia " & rs!Data_M & " pelas " & rs!Hora_M & vbNewLine + "Caso não possa comparecer, agradecemos nos informe com antecedência afim de podermos agendar nova marcação" + vbNewLine + vbNewLine + "Atenciosamente," + vbNewLine + "Marcelo - FisiOn"
    .Send 'ou Display para somente visualizar
End With
'marca como enviado
CurrentDb.Execute "UPDATE Avisa_Marcacao SET Notificado=-1 WHERE Cod=" & rs!Cod & ""
'fecha o recordset e limpa a memoria
rs.Close: Set rs = Nothing
'abre novamente o recordset onde Notificado não esteja marcado
    Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0")
    Loop
Else
MsgBox ("Sem Marcações a serem notificados.")
End If
End Sub


Agradeço a sugestão... mas antes de tentar implementar, agradecia me dissesse qual a diferença prática em relação ao que tenho, pois, mesmo que outlook nao esteja aberto, ele já cria e envia os mails.
Aguardo resposta
Obrigado

Se você estiver disposto a aprender, veja bem as diferenças.

Aproveitando, diga-nos para que serve isto:

Const sSUBJ As String = "Consulta Marcada"
Const sSQL As String = "SELECT [Mail] FROM Avisa_Marcacao;"

Boa tarde Mestre
Verdade... está duplicando a função!
Obrigado e bem haja.
E estou sempre disposto a aprender... sempre.

Obrigado

Mestre... depois de implementar tudo, verifiquei que se os pacientes não tiverem endereço de mail, o programa fica pendurado e não abre.
Precisava de um if... para o caso de não existir endereço de mail.
Pode me ajudar por favor?
Abraço

Coloquei assim...

Set rs = CurrentDb.OpenRecordset("Select * From Avisa_Marcacao WHERE Notificado =0 And Mail Is Not Null")

Mas acontece o seguinte...
Quando abro o programa, se tiver mails para enviar, o programa fica bloqueado e não abre o formulario de login especificado como formulario de arranque.
Mas fecho o programa e abro de novo... e vejo que todos os mails foram enviados.
Algum erro neste código ou sugere outro mais simples e pratico?
Abraço e obrigado!

Lol
Por vezes não pensamos.
Basta colocar na consulta para ignorar os dados sem endereço de mail.
Resolvido
Abraços