Anexos de e-mail.

[EasySoft Sistemas]

Boa tarde amigos.

Atualizai recentemente o ACBR e estou com problemas no envio de e-mail com mais de um anexo.

Apenas o ultimo anexo adicionado ao e-mail é encaminhado.


Vocês podem  me ajudar?
Obrigado.

[Juliomar Marchetti]

boa noite

poderia postar como está fazendo o uso do LibMail?

[EasySoft Sistemas]

function TfrmEnvioEmail.ExecutarEnvioEmail(const sSmtpHost,
                                                 sSmtpPort,
                                                 sSmtpUser,
                                                 sSmtpPasswd,
                                                 sFrom,
                                                 sTo,
                                                 sAssunto: String;
                                                 sMensagem : TStrings;
                                                 SSL : Boolean;
                                                 sCC: TStrings=nil;
                                                 Anexos:TStringList=nil;
                                                 PedeConfirma: Boolean = False;
                                                 AguardarEnvio: Boolean = False;
                                                 NomeRemetente: String = ''
                                          ) : Boolean;
var
 ThreadSMTP : TSendMailThread;
 m:TMimemess;
 p: TMimepart;
 StreamNFe : TStringStream;
 NomeArq : String;
 i: Integer;

 mmCopia : TStringList;
 vTimeOut : Shortint;
begin
    Result := False;
    mmCopia := TStringList.Create;
    mmCopia.Clear;

    m := TMimemess.create;

    ThreadSMTP := TSendMailThread.Create(Self) ;  // Não Libera, pois usa FreeOnTerminate := True ;

    StreamNFe  := TStringStream.Create('');

    try
        TratarsCC(sCC, mmCopia);

        TratarsTO(sTO, mmCopia);

        AnexarRodape(sMensagem, mmCopia, sFrom, sAssunto);

        ADDBody(m, sMensagem, p);

        ADDAnexos(Anexos, m, p);

        ADDDestino(m, p, NomeRemetente, sFrom, sAssunto, PedeConfirma);

        ThreadSMTP.FreeOnTerminate := True;
        ThreadSMTP.sFrom := sFrom;
        ThreadSMTP.sTo   := fDestino;

        if (mmCopia.Count > 0) then
            ThreadSMTP.sCC := mmCopia;

        ThreadSMTP.slmsg_Lines.AddStrings(m.Lines);

        ThreadSMTP.smtp.UserName := sSmtpUser;
        ThreadSMTP.smtp.Password := sSmtpPasswd;

        ThreadSMTP.smtp.TargetHost := sSmtpHost;

        if Trim(sSmtpPort)<>'' then
         ThreadSMTP.smtp.TargetPort := sSmtpPort;

        ThreadSMTP.smtp.FullSSL := SSL;
        ThreadSMTP.smtp.AutoTLS := IIF(Configurar_Integer(731) IN [2,3], True, False);    // TLS
        ThreadSMTP.Resume; // inicia a thread

        if AguardarEnvio then
        begin
            vTimeOut := 0;

            repeat
                Sleep(500);
                Application.ProcessMessages;
                inc(vTimeOut);

                if vTimeOut >= 6 then
                    break;
            until ThreadSMTP.Terminado;

            Result := not ThreadSMTP.OcorreramErros;
        end;
    finally
        m.free;
        StreamNFe.Free;

        mmCopia.Free;
    end;
end;
 

procedure TfrmEnvioEmail.ADDAnexos(Anexos:TStringList; m:TMimemess; p: TMimepart);
var i : Integer;
begin
    if not assigned(Anexos) then exit;

//    for i := 0 to Anexos.Count - 1 do
    for i := Anexos.Count - 1 downto 0 do
    begin
        if Anexos <> nil then
            m.AddPartBinaryFromFile(Anexos[i], p);
    end;
end;


Lembrando que o e-mail é enviado, mas, mesmo passando os anexos para a função, somente o último arquivo é enviado em anexo.

[EasySoft Sistemas]

???

[Daniel InfoCotidiano]

Boa tarde !
vou testar em nosso ambiente.
 

[Daniel InfoCotidiano]

@EasySoft Sistemas
Com o programa exemplo está funcionando.
Como temos ele em comum, pode testar com ele por favor

Faz um loop ai

 ACBrMail1.AddAttachment(Dir+NomeArquivo, 'Descricao do Anexo', adAttachment);