AJUDA COM LACO
Tenho um codigo de enviar email, e gostaria de enviar email para todos os emails cadastrados numa tabela do sql...
Tenho a tabela Email_Clientes, nela tem os campos Email e Nome
no código de enviar email pensei em fazer um while para pegar esses emails e enviar para todos, porém nao consegui fazer...
seria + - assim:
enviar email para: meuemail1;meuemail2;meuemail3
OBS: estou usando o metodo CDO para enviar email
em linhas curtas, preciso de um modo de buscar todos emails cadastrados na tabela Email_Clientes, e enviar o mesmo email para todos q estao nessa tabela...
obrigado desde ja
o meu código de enviar emails é este:
Citação:
Function EnviaEmail()
[ô]declara variaveis EnviaEmail()
Dim Objeto As CDO.Message
Dim Config As CDO.Configuration
Dim str As String
Dim EmailTO As Variant
Dim sEmailTo As Variant
Dim aEmailTo As Variant
Set Objeto = CreateObject([Ô]cdo.message[Ô])
Set Config = CreateObject([Ô]CDO.Configuration[Ô])
[ô]Configura servidor de SMTP
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/sendusing[Ô]) = 2
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpserver[Ô]) = [Ô]smtp.com.br[Ô]
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpserverport[Ô]) = 25
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpusessl[Ô]) = False [ô]Use SSL for the connection (True or False)
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout[Ô]) = 10
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpauthenticate[Ô]) = 1 [ô]basic (clear-text) authentication
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/sendusername[Ô]) = [Ô]Siss[Ô]
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/sendpassword[Ô]) = [Ô]SSS[Ô]
Objeto.Configuration.Fields.Update
Set Objeto.Configuration = Config
str = vbNullString
[ô]Assunto do Email
Objeto.Subject = [Ô]Carga SQL[Ô]
[ô]Corpo de mensagem
str = [Ô]Um Arquivo de carga não foi importado por completo, verifique a linha <b>[Ô] & iContador + 1 & [Ô]</b>, e rode novamente o programa de Carga de SQL[Ô]
Objeto.HTMLBody = str
[ô]Email de destino
Objeto.To = [Ô]meuemail@meuemail.com.br[Ô]
[ô]Email de envio
Objeto.From = [Ô]emailfrom@email.com.br[Ô]
Objeto.Send
Set Objeto = Nothing
Form1.statusBar.Caption = [Ô]Ocorreu um Erro. Email Enviado[Ô]
End Function
no código acima é uma funçao simples de enviar email, gostaria de saber como poderia fazer para pegar todos os emails da tabela Email_Cliente
e enviar este email para todos dessa tabela
Obrigado
--------------EDIT--------------------
Estava vendo uma forma, e o cara utilizou assim:
Citação:
If (InStr(1, sEmailTo, [Ô];[Ô]) <= 0) Then sEmailTo = sEmailTo & [Ô];[Ô]
aEmailto = Split(sEmailTo, [Ô];[Ô])
For i = 0 To UBound(aEmailto) - 1
oMail.AddRecipient aEmailto(i)
Next
mas nao obtive sucesso
[ô]Email de envio
[ô]Realiza o select da tabela Email_Cliente
dim RSEmail as new ADODB.Recordset
if rsemail.state <> 0 then rsemail.close
rsemail.open [Ô]Select * from Email_Cliente[Ô], Conexao
[ô]aqui faça seu tratamento de select como querer para verificar se o recordset foi aberto
[ô]Realiza o loop dos emails de cliente
Do While Not rsemail.EOF
Objeto.From = rsemail!Email
Objeto.Send
rsDadosOrigem.MoveNext
Loop
Set Objeto = Nothing
Form1.statusBar.Caption = [Ô]Ocorreu um Erro. Email Enviado[Ô]Amigo caso não der certo voce terá que fazer na funcao inteira beleza
porém eu testei com esse codigo que vc me passou mas nao obtive sucesso tambem...
nao creio que tenha que fazer na função inteira.
tenho uns exemplos aqui e todos eles utilizam o metodo q eu postei acima, mas n sei porque nao funcionou aqui
obrigado!
muito obrigado, mas dessa forma eu consigo fazer, ja que nao envolve o banco de dados...
o meu problema nao é enviar para mutiplos destinatarios... e sim fazer com que esses multiplos destinatarios sejam pegos de um campo do sql...
mas de qualquer forma
vlw mesmo
Aguardo...
[ô]Realiza o select da tabela Email_Cliente
dim RSEmail as new ADODB.Recordset
if rsemail.state <> 0 then rsemail.close
rsemail.open [Ô]Select * from Email_Cliente[Ô], Conexao
[ô]aqui faça seu tratamento de select como querer para verificar se o recordset foi aberto
[ô]Realiza o loop dos emails de cliente
Do While Not rsemail.EOF
Set Objeto = CreateObject([Ô]cdo.message[Ô])
Set Config = CreateObject([Ô]CDO.Configuration[Ô])
[ô]Configura servidor de SMTP
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/sendusing[Ô]) = 2
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpserver[Ô]) = [Ô]smtp.com.br[Ô]
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpserverport[Ô]) = 25
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpusessl[Ô]) = False [ô]Use SSL for the connection (True or False)
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout[Ô]) = 10
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/smtpauthenticate[Ô]) = 1 [ô]basic (clear-text) authentication
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/sendusername[Ô]) = [Ô]Siss[Ô]
Objeto.Configuration.Fields.Item([Ô]http://schemas.microsoft.com/cdo/configuration/sendpassword[Ô]) = [Ô]SSS[Ô]
Objeto.Configuration.Fields.Update
Set Objeto.Configuration = Config
str = vbNullString
[ô]Assunto do Email
Objeto.Subject = [Ô]Carga SQL[Ô]
[ô]Corpo de mensagem
str = [Ô]Um Arquivo de carga não foi importado por completo, verifique a linha <b>[Ô] & iContador + 1 & [Ô]</b>, e rode novamente o programa de Carga de SQL[Ô]
Objeto.HTMLBody = str
[ô]Email de destino
Objeto.To = [Ô]meuemail@meuemail.com.br[Ô]
[ô]Email de envio
[ô]Aqui vai o email retornado do select
Objeto.From = rsEmail!Email
Objeto.Send
rsemail.MoveNext
[ô]Finaliza
Set Objeto = Nothing
Set Config = Nothing
LoopAmigo coloque um trata erro em sua função caso der de email invalido ou outro problema
flw
obrigado pelas dicas, vou continuar testando
qualquer novidade eu posto...
essa forma, faria com que enviasse 1 email independente para cada carinha, com o while... porem nao busca o email do sql.
quando substituo Objeto.To =
fala que nao pode ser usado neste contexto...
de qualquer forma, creio existir algum outro tipo de fazer, pois a maioria dos programinhas q vi por ai, utilizam o metodo que havia dito, não sei como fizeram mas a maioria utiliza assim, Veja o exemplo de uma função de sendmail, esta funcao faz a busca dos emails dentro de uma tabela e coloca no addrecipient do jmail:
Citação:
Function SendEmail(sEmailFrom As Variant, sNameFrom As Variant, sEmailTo As Variant, sNameTo As Variant, sSubject As Variant, sBody As Variant) As Variant
Dim oMail, aNameto, aEmailto, oConst, i, sSmtp, sLogin, sPwd
On Error GoTo ErrorHandler
If (InStr(1, sNameTo, [Ô];[Ô]) <= 0) Then sNameTo = sNameTo & [Ô];[Ô]
If (InStr(1, sEmailTo, [Ô];[Ô]) <= 0) Then sEmailTo = sEmailTo & [Ô];[Ô]
aNameto = Split(sNameTo, [Ô];[Ô])
aEmailto = Split(sEmailTo, [Ô];[Ô])
[ô]sSmtp =[Ô]smtp.com.br[Ô]
sSmtp = [Ô]smtp.com.br
sLogin = [Ô]ssi[Ô]
sPwd = [Ô]sss[Ô]
sEmailFrom = sLogin
Select Case (GetFromINI([Ô]SOFTWARE[Ô], [Ô]EMAIL[Ô], [Ô]JMAIL[Ô], oConst.getFilesPathCOM & [Ô]Config.INI[Ô]))
Case [Ô]JMAIL[Ô]
Set oMail = CreateObject([Ô]jmail.message[Ô])
oMail.Silent = True
oMail.Logging = True
oMail.From = sEmailFrom
oMail.FromName = sNameFrom
For i = 0 To UBound(aEmailto) - 1
oMail.AddRecipient aEmailto(i), aNameto(i)
Next
oMail.Subject = sSubject
oMail.HTMLBody = sBody
oMail.MailServerUserName = sLogin
oMail.MailServerPassWord = sPwd
If (oMail.send(sSmtp)) Then
SendEmail = True
Else
SendEmail = False
sErro = oMail.Log
End If
Set oMail = Nothing
End Select
Exit Function
ErrorHandler:
sErro = sErro & [Ô]SYS.Utilities.SendEmail =>[Ô] & Err.Source & [Ô]->[Ô] & Err.Description
SendEmail = False
End Function
este sendmail funciona perfeitamente em um outro programinha que um outro desenvolvedor aqui da empresa fez,
ele faz um separador para os emaisl que vao receber, exemplo:
oMail.AddRecipient aEmailto(i), aNameto(i)
seria como ficasse assim:
oMail.AddRecipient meuemail1,MeuNome;meuemail2,MeuNome2;meuemail3,MeuNome3.....
onde teria o ; (ponto e virgula) separa o conjunto de email e nome de cada pessoa que esta no banco....
abraços
--------------------------------------------EDIT--------------------------------------------
Bom pessoal, depois de muita porrada, eu consegui fazer funcionar, deixo aqui o método que utilizei =)
Citação:
Dim oRs as Object
Dim sEmails as variant
Set oRs = con.Execute([Ô]select Email_Cliente from Tabela_Emails[Ô])
If Not oRs.EOF Then
While Not oRs.EOF
sEmails = sEmails & oRs(0) & [Ô];[Ô]
oRs.MoveNext
Wend
Objeto.To = sEmails
End If
quem utilizar pode verificar que a cada while a variavel sEmails, recebe + 1 valor de email, separado por ; (ponto e virgula), e no final do while a variavel ficara como eu precisava:
se colocar um MsgBox podera ver assim:
MsgBox sEmails
aparecerá:
meuemail1;meuemail2;meuemail3;meuemail4; e assim por diante...
ai atribuimos esta variavel sEmails ao .TO do send email
Objeto.To = sEmails, que se teoricamente ficaria assim:
Objeto.To = [Ô]meuemail1;meuemail2;meuemail3;meuemail4;[Ô]
Abraços
Closed