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
}
Referencias: http://www.djpate.freeserve.co.uk/AutoOutl.htm
No hay comentarios:
Publicar un comentario