[Resolvido]Mandar email buscando de uma tabela

Olá

Nao estou conseguindo funcionar o envio de emails buscando de uma tabela
Se alguem puder me ajudar
o campo Ender contem os enderecos de emails
Atentem para rs!Ender, pois esta dizendo q nao foi declarado e trazendo zerado


Segue o codigo

Function EnviarEmail()

On Error GoTo erromail

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


With Config

.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.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") = "XXXXX@hotmail.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ZZZZ"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update
End With

Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = "ANDRE " 'quem envia


.Sender = "andre@hotmail.com" 'email de quem envia

.Subject = "Teste envio email" 'Assunto
.HTMLBody = "Testando email" 'Mensagem a ser enviada

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes")
rs.MoveFirst
Do While Not rs.EOF
varEmail = rs!Ender
Call EnviarEmail
rs.MoveNext
Loop

rs.Close
Set rs = Nothing

.To = "varEmail" 'email de destino





.Send ' envia
End With
MsgBox "Mensagem enviada com sucesso." & vbCrLf & vbCrLf & "A CCS Sistemas agradece pela confiança.", vbOKOnly, "Dados enviados"

Set Mens = Nothing
Set Config = Nothing
Exit Function

erromail:
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description
End If





End Function

Boa tarde,
tem de criar o ciclo de percorrer a tabela de endereços e, dentro deste ciclo, enviar mensagem
sub EnviarEmail()

On Error GoTo erromail

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.live.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.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") = "XXXXX@hotmail.com"
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ZZZZ"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Fields.Update
End With

Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = "ANDRE " 'quem envia


.Sender = "andre@hotmail.com" 'email de quem envia

.Subject = "Teste envio email" 'Assunto
.HTMLBody = "Testando email" 'Mensagem a ser enviada

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes")
rs.MoveFirst
Do While Not rs.EOF
.To rs!Ender
.Send ' envia
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
End With

MsgBox "Mensagem enviada com sucesso." & vbCrLf & vbCrLf & "A CCS Sistemas agradece pela confiança.", vbOKOnly, "Dados enviados"

Set Mens = Nothing
Set Config = Nothing
exit sub
erromail:
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description
End If
End sub

Olá Alexandre

Muito Obrigado, vc é o cara amigo...

Executei o código e deu a mensagem

438 não aceita esta propriedade ou método

Usei uma variável ai funcionou

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes")
Dim EndMail As Variant
Set EndMail = rs!Ender

rs.MoveFirst
Do While Not rs.EOF
.To = EndMail
.Send ' envia
rs.MoveNext
Loop

Agora minha duvida é a seguinte:

gostaria do Where no recordset  campo DT_Nasc = ao campo 228 do formulário aberto
ou seja, quero mandar email pra quem está de aniversário,  com dia e mes igual ao form


Fiz ensaio assim, porem nao funcionou
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes WHERE DT_Nasc = [Forms]![Detalhes do Estudante]![Texto228]")

Boa noite,
Utilize, se Dt_Nasc estiver como texto
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes WHERE DT_Nasc='" & [Forms]![Detalhes do Estudante]![Texto228] &"'")

Funcionou desta maneira

Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Ender is Not null And DT_Nasc = #" & Format(Me!Texto228, "mm/dd/yyyy") & "#")



Gostaria de fazer o select pegando dia/mes do campo DT_Nasc = dia/mes do campo do formulario

Podem me ajudar por favor?

Bom dia,
Onde quer utilizar? Nos campos devolvidos ou no critério?
Utilize a função Format(DT_Nasc,'dd-mm')

Não utilize "is Not null", utilize " Not IsNull":
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull(Ender) And DT_Nasc = #" & Format(Me!Texto228, "mm/dd/yyyy") & "#")

Preciso que no select do recordset, traga os aniversariantes

Exemplo:

DT_Nasc = 10/05/1980 (campo data)
Texto228 do formulário = 10/05/2014

Tem que retornar os registros pois coincide 10/05 de DT_Nasc com 10/05 informado no formulário
como faço isso ? o rs abaixo esta funcionando, porem quero que compara apenas dd/mm

Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Ender is Not null And DT_Nasc = #" & Format(Me!Texto228, "mm/dd/yyyy") & "#")

Bom dia,
Utilize
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull(Ender) And Format(DT_Nasc,'dd-mm')='" & Format(Me!Texto228, "dd-mm") &"'")

erro

13 tipos incompativeis

Boa tarde,
Experimente
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull(Ender) And Format(DT_Nasc,'dd-mm')=" & Format(Me!Texto228, "dd-mm"))
e
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull(Ender) And Format(DT_Nasc,'dd-mm')=#" & Format(Me!Texto228, "dd-mm") &"#")

Boa Noite

Nao funcionou

nao estou conseguindo anexar o banco pra vc ver

Bom dia,
Pelas regras do fórum, o correio electrónico não deve ser utilizado
Se não consegue anexar, aconselho a criar conta, no dropbox por exemplo, e carregar o ficheiro e indicar o endereço

segue BD

No formulario detalhes do estudante
Botao comand

Boa tarde,
Utilize
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull(Ender) And Format(DT_Nasc,'dd-mm')='" & Format(Me!Texto228, "dd-mm") & "'")

Ola Alexandre

Obrigado amigo, agora funcionou as datas, porém esbarrei em outro probleminha, estou implementando na base real e está dando um erro de compilação, acredito que é porque meu campo do email tem espaços, como devo proceder?

Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull (Endereço de Email) And Format(DT_Nasc,'dd-mm')='" & Format(Me!Texto228, "dd-mm") & "'")


Dim EndMail As Variant
Set EndMail = rs!Endereço de Email

rs.MoveFirst
Do While Not rs.EOF
.To = EndMail
.Send ' envia
rs.MoveNext
Loop

Boa noite,
É um dos conselhos que sempre damos: nomes sem espaços nem caracteres especiais
Utilize
Set rs = CurrentDb.OpenRecordset("Select * From Estudantes where Not IsNull([Endereço de Email]) And Format(DT_Nasc,'dd-mm')='" & Format(Me!Texto228, "dd-mm") & "'")

Boa tarde Alexandre

Muito obrigado
Está funcionando perfeitamente graças a sua ajuda.

Um abraço

André