Envio de Newsletter - Mala Direta via Email - Sugestões

Olá...

É preciso saber do por quê que [b:98305c60c2]´para´[/b:98305c60c2]. Se ele enviar dois e-mails dá certo? Se der certo, a quantidade não tem nada a ver com isso! Pode ser que seja o servidor que não aguente ou não permita o envio de muitos e-mails....

Então, eu não sei se é o componente mkemail que demora para retornar, sinceramente não sei ...

Provedor também enche o saco, mas arrumamos um que é mais sossegado quando à ´politica de spam´ (um dia desses até recebi um comunicado do nosso amigo Cantu, da Firebase que eles estavam mudando de provedor por conta disso).

Preciso de sugestões diversas de como mandar essa paulada de emails!!

Vlw

up

Vou postar aqui um codigo meu que funciona a muito tempo sobre envio de mala direta.

procedure TFrmEnviaEmail.BitBtn1Click(Sender: TObject);
var
IdMessage : TIdMessage;
//Attach : TIdAttachment;
ArquivoHtml : TStringList;
qtdExec : integer;
qtdEnviada : integer;
qtComErro : integer;
begin
inherited;
if not (rgTipoEnvio.ItemIndex in [0,1,2,3]) then
begin
ShowMessage(´Selecione o tipo de envio´);
rgTipoEnvio.SetFocus;
end;

BitBtn1.Enabled := False;
Screen.Cursor := crHourGlass;

qtdExec := 0;
qtdEnviada := 0;
qtComErro := 0;
IdMessage :=TIdMessage.Create(Self);

IdMessage.From.Text :=EditRemetente.Text;

{ if not chkSemAutenticacao.Checked then
IdSMTP.AuthType := atDefault
else
IdSMTP.AuthType := atNone;}


IdSMTP1.Host := EdtSMTPHost.Text;//´ip do servidor´;
IdSMTP1.UserName := EdtUsuario.Text;//´usuario´;
IdSMTP1.Password := EdtSenha.Text;//´senha´;

ArquivoHtml := TStringList.Create;
try
IdSMTP1.Connect;
except
on E : Exception do
begin
BitBtn1.Enabled := True;
Screen.Cursor := crDefault;
ShowMessage(E.Message);
Exit;
end;
end;

PanelTotal.Caption := ´´;

pbEnvia.Max := FrmCadUsuarios.CDS.RecordCount;
pbEnvia.Min := 0;
pbEnvia.Position := 0;
FrmCadUsuarios.CDS.First;
if FrmCadUsuarios.nRecPosition > 0 then
FrmCadUsuarios.CDS.RecNo := FrmCadUsuarios.nRecPosition;

if EditHtml.Text <> ´´ then
begin
ArquivoHtml.LoadFromFile(EditHTML.Text);
end;

while not FrmCadUsuarios.CDS.Eof do
Begin
if Trim(FrmCadUsuarios.CDSEMAIL.Value) <> ´´ then
begin
if rgTipoEnvio.ItemIndex = 0 then
begin
EnviarEmail(ArquivoHtml, qtdExec, IdMessage, qtdEnviada, qtComErro);
end
else if rgTipoEnvio.ItemIndex = 1 then
begin
if FrmCadUsuarios.CDSAUTORIZAEMAIL.AsString = ´S´ then
EnviarEmail(ArquivoHtml, qtdExec, IdMessage, qtdEnviada, qtComErro);
end
else if rgTipoEnvio.ItemIndex = 2 then
begin
if FrmCadUsuarios.CDSAUTORIZAMALA.AsString = ´S´ then
EnviarEmail(ArquivoHtml, qtdExec, IdMessage, qtdEnviada, qtComErro);
end
else if rgTipoEnvio.ItemIndex = 3 then
begin
if (FrmCadUsuarios.CDSAUTORIZAEMAIL.AsString = ´S´)
and (FrmCadUsuarios.CDSAUTORIZAMALA.AsString = ´S´) then
EnviarEmail(ArquivoHtml, qtdExec, IdMessage, qtdEnviada, qtComErro);
end;
end;
FrmCadUsuarios.CDS.Next;
end;

ArquivoHtml.Free;
IdSMTP1.Disconnect;
IdMessage.Free;
PanelTotal.Caption := ´Qtd. Enviada: ´ + IntToStr(qtdExec) +
´ - Qtd. Enviada com Sucesso: ´ + IntToStr(qtdEnviada) +
´ - Qtd. de Erros: ´ + IntToStr(qtComErro);
BitBtn1.Enabled := False;
Screen.Cursor := crDefault;
end;

procedure TFrmEnviaEmail.EnviarEmail(ArquivoHtml: TStringList; var qtdExec: Integer; var IdMessage: TIdMessage; var qtdEnviada: Integer; var qtComErro: Integer);
begin
try
lbNome.Caption := FrmCadUsuarios.CDSNOME.AsString + ´ ´ + FrmCadUsuarios.CDSSOBRENOME.AsString;
lbEmail.Caption := FrmCadUsuarios.CDSEMAIL.AsString;
lbCodigo.Caption := FrmCadUsuarios.CDSID_USUARIO.AsString;
lbPosicao.Caption := IntToStr(FrmCadUsuarios.CDS.RecNo);
IdMessage.Recipients.EMailAddresses := FrmCadUsuarios.CDSEMAIL.Value;
IdMessage.Date := Date;
IdMessage.Subject := EditAssunto.Text;
IdMessage.Priority := mpNormal;
if EditHtml.Text = ´´ then
begin
IdMessage.ContentType := ´text/plain´;
IdMessage.Body.Text := ´Prezado(a) ´ + FrmCadUsuarios.CDSNOME.AsString +
´´#13´´ + ´´13´´ + MemoTexto.Lines.Text;
end
else
begin
IdMessage.ContentType := ´text/html´;
IdMessage.Body.Text := ´Prezado(a) ´ +
FrmCadUsuarios.CDSNOME.AsString + ´ ´ +
FrmCadUsuarios.CDSSOBRENOME.AsString + ´´
+ ´´13´´ + ´´13´´ + ArquivoHtml.Text;
end;
IdMessage.IsEncoded := True;
IdSMTP1.Send(IdMessage);
qtdExec := qtdExec + 1;
Application.ProcessMessages;
Update;
qtdEnviada := qtdEnviada + 1;

except
qtComErro := qtComErro + 1;
IdSMTP1.Disconnect(True);
IdSMTP1.Connect;
end;
pbEnvia.Position := pbEnvia.Position + 1;
Application.ProcessMessages;
Update;
end;

Espero poder ajudar.

ja usei este processo com mais de 100 mil registros. so pra constar.

Valeu ! Vou implementar aqui no meu projeto :!:

Bruno,

Qual versão do INDY você usa? Aqui deu erro nessa linha:





[ ]´s

este codigo funciona desde o Delphi 7, eu apenas venho migrando a minha aplicação, mas funciona desdeo Delphi 7 Enterprise, hoje está com Delphi 2007 Enterprise.

Versão do Delphi, tudo bem...
Mas a versão do INDY (por exemplo indy9.0.18_d7.exe ) é que estou com dúvida, porque aqui o desconecta não tem aquele parâmetro.
De qualquer forma funcionou apenas com o desconecta
Valeu

Ele quis dizer qual a versão do componente INDY. Já passei por esses problemas de versões do Indy com vídeo-aulas daqui da ClubeDelphi. Uma das versões não funcionava (as mais novas), eu tive de sair pesquisando e, numa das pesquisas, vi que faltava acrescentar algumas units no projeto, e, em alguns casos tive que remover os componentes e recolocar novamente pois na versão anterior existia propriedades que nas novas foram removidas.... Poristo é bom informar qual a versão da Indy você usa...

Blz.

Entãoo pessoal,

A versão do indy é sempre a que vem como padrão na distribuição do Delphi.

Minha versao correte padrão do Delphi 2007 onde atualmene funciona é:
10.0.0.17

Neste seu exemplo, nao entendi direito:
o envio é:
Um mesmo email para multiplos enderecos
1 por 1 de cada vez
ou
n enderecos no CCo de cada vez ?

Valeu !

neste exemplo cada email gera uma mensagem, mas todas utilizam a mesma conexao. Caso haja erro a conexao e refeita e continua-se o envio.