Enviar adjunto HTML

[jceluce]

Hola, te paso la formar en que yo lo hice a ver si te ayuda (no sé si cambia algun nombre o propiedad de los componentes ya que yo lo hice con las Indy8):

Saludos

Código Delphi [-]
      
     with idMessage1 do begin
        // Cuerpo del mensaje.
        Body.Clear;
        MessageParts.Clear;
        ContentType := 'text/html';


        with TIdText.Create(IdMessage1.MessageParts, nil) do begin
          Body.LoadFromFile(edFileName.Text);  // El archivo con el html
          ContentType := 'text/html';
        end;

        // Cuenta Origen.
        From.Address := FieldByName('CE_DIRECCION').AsString;
        From.Name := FieldByName('CE_NOMBRE').AsString;
        // direccion de respuesta
        ReplyTo.EMailAddresses := FieldByName('CE_RESPUESTA').AsString;
        // Asunto del email.
        Subject := edAsunto.Text;
        // Prioridad del mensaje, ALTA.
        Priority := TidMessagePriority(mpHighest);
      end;


      with idSMTP1 do begin
        // Configuro autentificación.
        AuthenticationType := atLogin;
        UserId := FieldByName('CE_SMTP_USERID').AsString;  // Nombre del usuario
        Password := FieldByName('CE_SMTP_PASSWORD').AsString;  // la password
        // Configuro el servidor SMTP.
        Host := FieldByName('CE_SMTP').AsString;
        Port := 25;

        try
          Connect;
          try
            // Envio el mensaje.
            Estado := 'Enviando emails...';

            With DM, QResult do begin
              FetchAll;

              pbProgreso.Max := RecordCount;

              if chkDestinatarios.Checked then
                MaxDestinatarios := Trunc(edMaxDest.Value)
              else
                MaxDestinatarios := RecordCount;


              // Cuenta Destino.

              idMessage1.Recipients.EMailAddresses := idMessage1.ReplyTo.EMailAddresses;

              idMessage1.BccList.Clear;
              First;
              While not EOF do begin

                pbProgreso.Position := RecNo;
                pbProgreso.Refresh;

                if ValidaEmail(FieldByName('email').AsString) then
                  With idMessage1, BCCList do begin
                    Add.Address := Trim(FieldByName('email').AsString);
                    if Count = MaxDestinatarios then begin
                      //Send(idMessage1);
                      EnviaEmail;
                      BCCList.Clear;
                    end;
                  end;

                Next;
              end;

              With idMessage1, BccList do
                if Count > 0 then EnviaEmail; //Send(idMessage1);

            end;

            Estado := 'Desconectando...';

          finally
            Disconnect;
            Screen.Cursor := crDefault;
          end;
          //ShowMessage('El Pedido fue enviado correctamente !!!');
        except
           // Capturo algunas excepciones que pueden ocurrir
          ON E: EIdProtocolReplyError do begin
            ShowMessage('No se ha podido enviar el email.' + #13 +
                'Incorrecto el email o el usuario o la password.' + #13 +
                E.Message + #13 + idMessage1.BccList.EMailAddresses);
          end;
          on E: EFOpenError do begin
            ShowMessage('No se ha podido enviar el email.' + #13 +
                'Fichero Adjunto desconocido o erróneo.');
          end;
          on E: EIdSocketError do begin
            ShowMessage('No se ha podido enviar el email.'+ #13 +
                'Host desconocido o incorrecto.');
          end
          else begin
            ShowMessage('Fallo en el envio de email');
          end;
        end;
        if connected then Disconnect;

      end;