Automatizando Outlook

Funciones que tenemos que utilizar cuando queremos automatizar el programa Outlook desde Delphi.


Crear un objeto Outlook

var 
  Outlook, NmSpace, Folder: OleVariant; 
begin 
  Outlook := CreateOleObject('Outlook.Application');    
  NmSpace := Outlook.GetNamespace('MAPI');
  NmSpace.Logon(EmptyParam, EmptyParam, False, True);
  Folder := NmSpace.GetDefaultFolder(olFolderInbox);
  Folder.Display;


Cerrar Outlook


  NmSpace.Logoff;
  Outlook.Quit;
  Outlook.Disconnect;   
  { or }
  Outlook := nil;      
  { or }
  Outlook := Unassigned; //hacerlo así se usamos variants




Leer un mensaje

var
s: string;
objCDO: OLEVariant;
begin
objCDO := CreateOLEObject('MAPI.Session');
objCDO.Logon('', '', False, False);
objMsg := objCDO.GetMessage(itemOL.EntryID, itemOL.Parent.StoreID);

s := objMsg.Sender.Address;
ShowMessage(s);
objMsg := Unassigned;
objCDO := Unassigned;
end

//donde itemOL es un  MailItem que contiene  SenderName pero no contiene   SenderAddress


Componer un email
const
  olMailItem = 0;
var
  Email: Variant;
begin
 Email := Outlook.CreateItem(olMailItem);
  Email.Recipients.Add('Debs@djpate.freeserve.co.uk');
  Email.Subject := 'Greetings, O gorgeous one';
  Email.Body := 'Your web pages fill me with delight';
  Email.Attachments.Add('C:\CreditCardNo.txt', EmptyParam, EmptyParam, EmptyParam);
  Email.Send;

Enviar / recibir email
uses Office_TLB; 
var
ToolsMenu: CommandBar;
SendRecMenuItem, AllAccs: CommandBarControl;
begin
ToolsMenu := (Outlook.ActiveExplorer.CommandBars as CommandBars).Item['Tools'];
SendRecMenuItem := ToolsMenu.Controls_['Send and Receive'];
AllAccs := (SendRecMenuItem.Control as CommandBarPopup).Controls_['All Accounts'];
AllAccs.Execute;


Chequear el email no leído
var
   Inbox: MAPIFolder;
   NewMail: boolean;
...
   Inbox := NmSpace.GetDefaultFolder(olFolderInbox);
   NewMail := (Inbox.UnreadItemCount > 0);
   if NewMail then
     ShowMessage(Format('Unread items in Inbox: %d', [Inbox.UnreadItemCount]));

The constant olFolderInbox is defined in Outlook_TLB as $00000006.


Chequear el email no enviado
var
   Outbox: MAPIFolder;
   UnsentMail: integer;
...
   Outbox := NmSpace.GetDefaultFolder(olFolderOutbox);
   UnsentMail := Outbox.Items.Count;
   if (UnsentMail > 0) then
     ShowMessage(Format('Unsent items in Outbox: %d', [UnsentMail]));




The constant olFolderOutbox is defined in Outlook_TLB as $00000004




Añadir un contacto a la libreta de direcciones de Outlook
uses
ComObj, Variants, SysUtils;

type
TContact = record
   LastName: string;
   FirstName : string;
   Company : string;
   // ###  Further properties. See MSDN
end;


//------------------------------------------------------------------------------
{:Add outlook contact

@param ContactFolderPath The contact path. E.g.: '' for default contact folder,
'SubFolder\Sub2\Test' for subfolders
@param Contact The contact informations.
@author 19.09.2003 Michael Klemm}
//------------------------------------------------------------------------------
procedure OutlookAddContact(ContactFolderPath : string; Contact : TContact);
const
olFolderContacts = $0000000A;
var
Outlook : OleVariant;
NameSpace : OleVariant;
ContactsRoot : OleVariant;
ContactsFolder : OleVariant;
OutlookContact : OleVariant;
SubFolderName : string;
Position : integer;
Found : boolean;
Counter : integer;
TestContactFolder : OleVariant;
begin
// Connect to outlook
Outlook := CreateOleObject('Outlook.Application');
// Get name space
NameSpace := Outlook.GetNameSpace('MAPI');
// Get root contacts folder
ContactsRoot := NameSpace.GetDefaultFolder(olFolderContacts);
// Iterate to subfolder
ContactsFolder := ContactsRoot;
while ContactFolderPath <> '' do
begin
   // Extract next subfolder
   Position := Pos('\', ContactFolderPath);
   if Position > 0 then
   begin
     SubFolderName := Copy(ContactFolderPath, 1, Position - 1);
     ContactFolderPath := Copy(ContactFolderPath, Position + 1, Length(ContactFolderPath));
   end
   else
   begin
     SubFolderName := ContactFolderPath;
     ContactFolderPath := '';
   end;
   if SubFolderName = '' then
     Break;
   // Search subfolder
   Found := False;
   for Counter := 1 to ContactsFolder.Folders.Count do
   begin
     TestContactFolder := ContactsRoot.Folders.Item(Counter);
     if LowerCase(TestContactFolder.Name) = LowerCase(SubFolderName) then
     begin
       ContactsFolder := TestContactFolder;
       Found := True;
       Break;
     end;
   end;
   // If not found create
   if not Found then
     ContactsFolder := ContactsFolder.Folders.Add(SubFolderName);
end;
// Create contact item
OutlookContact := ContactsFolder.Items.Add;
// Fill contact information
OutlookContact.FirstName := Contact.FirstName;
OutlookContact.LastName := Contact.LastName;
OutlookContact.CompanyName := Contact.Company;

// ### Further properties

// Save contact
OutlookContact.Save;
// Disconnect from outlook
Outlook := Unassigned;
end;



Eliminar todos los archivos adjuntos que hayan sido enviados por un determinado email
uses
comobj;

{...}

function manageattachments(sendersname, attachmentpath: string;
maildelete: boolean): boolean;
var
oapp: variant;
ons: variant;
ofolder: variant;
omsg: variant;
atc: variant;
attfilename: variant;
filename: string;
checksender: string;
counter: integer;
mailcounter: integer;
begin
try
oapp := createoleobject('outlook.application');
try
ons := oapp.getnamespace('mapi');
ofolder := ons.getdefaultfolder(6); // foldertypeenum (olfolderinbox)
mailcounter := 1;
// if there is any email in the inbox
if ofolder.items.count > 0 then
begin
repeat
// get the first email
omsg := ofolder.items(mailcounter);
// check the name or email
// use checksender := omsg.subject to search on subject;
checksender := omsg.sendername;
if checksender = sendersname then
// remove this line to backup all your attachments.
begin
// check how many attachments
atc := omsg.attachments.count;
if atc > 0 then
begin
// get all the attachments and save them
for counter := 1 to atc do
begin
attfilename := omsg.attachments.item(counter).filename;
//filename := includetrailingbackslash(attachmentpath)+attfilename; {use this line for d5)}
filename := attachmentpath + '' + attfilename;
omsg.attachments.item(counter).saveasfile(filename);
end;
end;
if maildelete then
begin
omsg.delete;
// there's 1 email less, so mailcounter - 1
dec(mailcounter);
end;
end;
// get the next email
inc(mailcounter);
// do until there is no more email to check
until mailcounter > ofolder.items.count;
end;
finally
oapp.quit;
end;
except
result := false;
exit;
end;
result := true;
end;


procedure tform1.button1click(sender: tobject);
begin
// manageattachments(email or name, backup directory, maildelete yes or no)
manageattachments('info@cleys.com', 'f:test', false);
end;


{
warning!
all your selected email will be deleted if maildelete = true
autor: patrick cleys 
homepage: http://www.dcmedical.org 
}












No hay comentarios:

Publicar un comentario