Problema con envio de correos con fichero adjunto

[apicito]

estoy intentando mandar correos con ficheros adjuntos y me envia correctamente el correo pero el adjunto no.
Utilizo esto código:
procedure TCorreoSmtp.EnviarMail;
var SMTP: TIdSMTP;
Mensaje: TIdMessage;
Adjunto: TIdAttachmentFile;
i: integer;
begin
if trim(EDestinatario.Text)='' then begin
Showmessage('Debe especificarse un destinatario');
Exit;
end;
SMTP := TIdSMTP.Create( nil );
SMTP.Username := sUsuario;
SMTP.Password := sClave;
SMTP.Host := sHost;
try
SMTP.Port := strtoint(sPort);
except
SMTP.Port := 25;
end;
SMTP.AuthType := satDEFAULT; //satNONE, satDEFAULT, satSASL
Mensaje := TIdMessage.Create( nil );
Mensaje.Clear;
Mensaje.ReplyTo.EMailAddresses := sReplyTo;
with TIdText.Create(Mensaje.MessageParts, nil) do begin
for i := 0 To Memo.Lines.Count -1 do
SMensaje := SMensaje + '<br>' + Memo.Lines[i];
Body.Text := sMensaje;
ContentType := 'text/html';
end;
Mensaje.From.Name := sFromNome;
Mensaje.From.Address := sFromEmail;
Mensaje.Subject := sAsunto;
if trim(sCopia)<>'' then begin
Mensaje.BccList.Add;
Mensaje.BccList.Items[0].Address := sCopia;
end;
Mensaje.Recipients.Add;
Mensaje.Recipients.Items[0].Address := sDestino;

if (sAdjunto <> '') and (FileExists( sAdjunto )) then begin
Adjunto := TIdAttachmentFile.Create(Mensaje.MessageParts, sAdjunto);
Mensaje.ContentType := 'multipart/related';
end else begin
Adjunto := nil;
Mensaje.ContentType := 'multipart/alternative';
end;

try
SMTP.Connect;
except
raise Exception.Create( 'Error al conectar con el servidor' );
end;
if SMTP.Connected then
begin
try
SMTP.Send( Mensaje );
except
raise Exception.Create( 'Error al enviar el mensaje.' );
end;
try
SMTP.Disconnect;
except
raise Exception.Create( 'Error al desconectar del servidor.' );
end;
end;
if Adjunto <> nil then
FreeAndNil( Adjunto );
FreeAndNil( Mensaje );
FreeAndNil( SMTP );
end;
Alguien ve algo raro en este código?
Un saludo.

[newtron]

Hola, yo no lo hago exactamente así, no sé si será por la versión de las Indy.

Prueba de esta manera:


TIdAttachmentFile.Create(Mensaje.MessageParts, sAdjunto);


Saludos

[apicito]

He probado y si gue sin funcionar.
Supongo que la diferencia que me propones es no asignar la creación deTIdAttachmentFile a una variable?

[newtron]

Hola de nuevo.

Este es mi código y funciona


IdEnviar := TIdMessage.Create(Self);
TextoMensaje:=Texto+#13+#10+Firma+#13+#10+TablaDatos.FieldByname('TEXTOMAIL').Value;
IdEnviar.Body.Text := TextoMensaje;
IdEnviar.From.Address := CorreoPropio; { e-mail del que envía }
IdEnviar.From.Name := DlgPropiedades.NombreEmpresa; { El nombre del que envía }
IdEnviar.Subject := Subject;

TIdAttachmentFile.Create(IdEnviar.MessageParts, GetTempDir+'\DOCUMENTO.PDF'); //Para adjuntar archivos al mensaje

ElDestinatario := IdEnviar.Recipients.Add;
ElDestinatario.Address := Correo; { Primer destinatario }
// ElDestinatario.Name := 'Nombre del primer destinario';
If Copia<>'' then begin
ElDestinatario := IdEnviar.Recipients.Add;
ElDestinatario.Address := Copia; { Primer destinatario }
end;
Bd.CierraTabla (TablaDatos);
Application.ProcessMessages ;
IdSMTP1.Host := Host;
IdSMTP1.UserName := UserId;
IdSMTP1.Password := Pass;
if Puerto<>0 then IdSMTP1.Port:= Puerto;
Try
IdSMTP1.Connect;
try
IdSMTP1.Send(idEnviar);
finally

end;

except
ShowMessage('¡ATENCION! Problema de conexion');
Close;
end;
IdSMTP1.Disconnect(true);


Mira a ver si puedes probar con esto.

[apicito]

Ya Está !!!
Solo he comentado las lineas "Mensaje.ContentType" y funcionó a la primera.
// Si hay que meter un archivo adjunto lo creamos y lo asignamos al mensaje
if (sAdjunto <> '') and (FileExists( sAdjunto )) then begin
Adjunto := TIdAttachmentFile.Create(Mensaje.MessageParts, sAdjunto);
//Mensaje.ContentType := 'multipart/related';
end else begin
Adjunto := nil;
//Mensaje.ContentType := 'multipart/alternative';
end;
Gracias por tu ayuda. :)

[newtron]

Pues fíjate que pensé en decirte que hicieras eso pero pensé..."mejor se lo mando completo y no damos muchos cabezazos".

Me alegro que ya te funcione.

Saludos