Ver Mensaje Individual
  #2  
Antiguo 31-01-2009
Avatar de ContraVeneno
ContraVeneno ContraVeneno is offline
Miembro
 
Registrado: may 2005
Ubicación: Torreón, México
Posts: 4.738
Reputación: 24
ContraVeneno Va por buen camino
Código Delphi [-]
Uses Outlook2000
...
Function Tfrm.EnviarCorreo(const Titulo, Mensaje, NombreArchivo, NombreArchivoCompleto, 
                                      CorreoDestino, CorreoAlterno: String; AutoEnvio: Boolean): Boolean;
var
Outlook: _Application;
AFolder : MAPIFolder;
ANameSpace : _NameSpace;
AMailItem : _MailItem;
AAttachments : Attachments;
AppWasRunning: boolean; //Comprobar ejecución de outlook
lcid: integer; //ID usuario
Unknown: IUnknown;
Resultado: HResult;
begin
 lcid := LOCALE_USER_DEFAULT;
 //----
 Resultado := GetActiveObject(CLASS_OutlookApplication, nil, Unknown);
 if (Resultado = MK_E_UNAVAILABLE) or (AppWasRunning) then
  Outlook := CoOutlookApplication.Create
 else begin
  OleCheck(Resultado); // Comprobar que se generó el objeto
  OleCheck(Unknown.QueryInterface(_Application, Outlook));
  AppWasRunning := True; // Establece que outlook esta ejecutándose
 end;
 //Obtener Sesión
 ANameSpace := Outlook.Get_Session;
 //Obtener bandeja de entrada
 AFolder := ANameSpace.GetDefaultFolder(olFolderInbox);

 //Muestra la carpeta de entrada
 //AFolder.Display;

 //Genera un nuevo correo
 AMailItem := (Outlook.CreateItem(olMailItem) as MailItem);
 AMailItem.To_ := CorreoDestino;
 AMailItem.CC := CorreoAlterno;
 AMailItem.Subject := Titulo;
 AMailItem.Body := Mensaje;

 AAttachments := AMailItem.Get_Attachments;

 //Agregar adjuntos en caso de que existan
 if (Length(NombreArchivoCompleto) > 0) then begin
  AAttachments.Add(NombreArchivoCompleto,$00000001 ,
  Length(Mensaje)+1,NombreArchivo);
 end;

 AMailItem.Save;
 If AutoEnvio then begin
   Try
    AMailItem.Send;
    Result := True;
    except on E:EExternal do begin
      Result := False;
    end;
   end;
 end else begin
  try
   AMailItem.Display(0);
   Result := True;
   except on E:EExternal do begin
    Result := False;
    Raise;
   end;
  end;
 end;
 //MessageDlg('Correo Enviado Correctamente',mtinformation,[mbok],0);
 // Outlook.Quit; //Cierra Outlook
end;

No recuerdo de donde exactamente obtuve ese código, pero me funciona en todas las versiones del Outlook 2000, 2003 y 2007.
__________________

Responder Con Cita