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 


}





Referencias:  http://www.djpate.freeserve.co.uk/AutoOutl.htm




































Automatizando CorelDraw

Funciones que se utilizan cuando queremos manejar archivos creados con CorelDraw dentro de nuestros programas Delphi





Abrir un documento Corel




var


 
CorelDraw: Variant;


 


CorelDraw := CreateOleObject('CorelDraw.Automation.8');


CorelDraw.FileNew;


 
// también se puede usar CorelDraw.FileOpen(FileName);


CorelDraw.SetDocVisible(True);


CorelDraw.FileSave('NewName', 0,
False,
0, False);


CorelDraw.FileExit(False); 


CorelDraw := Unassigned;





Parámetros de la función FileSave




FileName: WideString


ThumbNailSize: Integer


SaveSelectedOnly: WordBool


FileVersion: Integer


IncludeCMXData: WordBool













Abrir un documento usando COM




  var


    Disp: IDispatch;


  begin


    Disp := CreateComObject(CLASS_CDrawAutomate) as IDispatch;


    Draw := IDrawAutomate(Disp);










Cerrar  CorelDraw




  Draw.FileExit(False);


  Draw := nil;             // si Draw es una variable del tipo IDrawAutomate 





o





  Draw.FileExit(False);


  Draw := Unassigned;      // si Draw es una variable de tipo variant










Cerrar un documento


 Draw.FileClose(False); 





Cambiar la orientación del texto y otras propiedades.




CorelDraw.SetPageOrientation(0);


CorelDraw.SetPageSize(PageW, PageH);


CorelDraw.NewLayer('NewLayer1');


CorelDraw.SelectLayer('NewLayer1');


CorelDraw.CreateEllipse(CalcY(Y1)), CalcX(X1), CalcY(Y2),
CalcX(X2),
0, 0,
0);


CorelDraw.CreateRectangle(CalcY(Y1)), CalcX(X1), CalcY(Y2),
CalcX(X2), CalcX(Radius));








Primero hay que crear el objeto del dibujo y luego se asignan distintas propiedades, como color, tipo de relleno, grosor, etc Por defecto, estos valores no se pueden establecer a través de la automatización.







CorelDraw.CreateArtisticText( Text, CalcX(X), CalcY(Y));


With
Font
do


 
begin


 
if
(Italic)
and
(Bold)
then
FSK:=
14 else


 
if
(Italic)
then
FSK:=
8 else


 
if
(bold)
then
FSK:=
13 else FSK:=7;


 
end;


CorelDraw.SetCharacterAttributes( 0, 0,
Font.
Name, FSK, Abs(Font.Size)*10,


 
0, 0,
0, 0,
0, 1000, 1000, HAlign);


ColorToCMYK(Font.Color, C,M,Y,K);


CorelDraw.StoreColor(2,
C,M,Y,K,
0,0,0,0); 


CorelDraw.ApplyUniformFillColor; 







CorelDraw.GetSize(XSize, YSize); 


CorelDraw.MoveObject(0,
-YSize); 





Mostrar todos los objetos:




var
ObjID, FirstObjID:longint;


begin


CorelDraw.SelectAllObjects;


CorelDraw.SelectNextObject(true);


FirstObjID := CorelDraw.GetObjectsCDRStaticID;


Repeat


...


// otra opción    CorelDraw.SelectNextObject(true);


ObjID :=
CorelDraw.GetObjectsCDRStaticID;


Until ObjID = FirstObjID; ...



















Lotus Notes con Delphi

Abre la base de datos de Lotus Notes  names.nsf y muestra su libro de direcciones.






unit
Unit1;





interface





uses


Windows,
Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,


Dialogs,
Domino_TLB, Menus, ComCtrls;


const


PASSWD =
'ur70';


type


TForm2 =
class(TForm)


  
TV_INFO: TTreeView;


  
MainMenu1: TMainMenu;


  
File1: TMenuItem;


  
Create1: TMenuItem;


  
Init1: TMenuItem;


  
AddressBook1: TMenuItem;


  
Scan1: TMenuItem;


  
procedure Create1Click(Sender: TObject);


  
procedure Init1Click(Sender: TObject);


  
procedure Scan1Click(Sender: TObject);


private


  
{ Private declarations
}


public


  
{ Public declarations
}


end;





var


Form2:
TForm2;


Session:
TNotesSession;


implementation





{$R
*.dfm}





procedure TForm2.Create1Click(Sender: TObject);


begin


Session
:= TNotesSession.Create(
nil);


end;





procedure TForm2.Init1Click(Sender: TObject);


begin


Session.Initialize(PASSWD);


end;








Abre la base de datos names.nsf y muestra el libro de direcciones





procedure TForm2.Scan1Click(Sender: TObject);


var


NotesDb:
NotesDatabase;


addrBook: NotesDatabase;


People,
People2: NotesView;


Person,
Person2: NotesDocument;


View:
NotesView;


Item:
NotesItem;


AddrBooks: OleVariant;


Views:
OleVariant;


Items:
OleVariant;


x, y, z:
integer;


view_name: string;


tn, tc:
TTreeNode;


begin


NotesDb
:= Session.GetDatabase(
'',
'names.nsf', False);


AddrBooks := Session.AddressBooks;


for
x :=
0 to VarArrayHighBound(AddrBooks,
1) -


  
VarArrayLowBound(AddrBooks,
1)
do


begin


  
addrBook := NotesDatabase(IUnknown(AddrBooks[x]));


  
if
(addrBook.IsPrivateAddressBook)
then


  
begin


    
addrBook.Open;


  
end


  
else


    
addrBook :=
nil;


  
if
(addrBook <>
nil)
then


  
begin


    
Views := addrBook.Views;


    
for
y :=
0 to VarArrayHighBound(Views,
1) -


      
VarArrayLowBound(Views,
1)
do


    
begin


      
View := NotesView(IUnknown(Views[y]));


      
view_
name
:= View.
Name;


      
tn := tv_info.Items.AddNode(
nil, nil, view_name, nil, naAdd);





      
if
copy(view_
name, 1,
1) = '$' then


        
view_
name
:= copy(view_
name, 2,
length(view_
name) - 1);


      
people := addrBook.GetView(view_
name);


      
person := people.GetFirstDocument;


      
if
Person <>
nil
then


      
begin


        
Items := Person.Items;


        
for
z :=
0 to VarArrayHighBound(Items,
1) -


           VarArrayLowBound(Items, 1) do


        
begin


           Item := NotesItem(IUnknown(Items[z]));


           tc := tv_info.Items.AddChild(tn,
Item.
Name);





           people := addrBook.GetView(view_name);


           person := people.GetFirstDocument;





           while (Person <> nil) do


           begin


             try


               try


                 tv_info.Items.AddChild(tc,
Person.GetFirstItem(Item.
Name).Text


                   {Item.Text});


               except


               end;


             finally


               Person :=
People.GetNextDocument(Person);


             end;


           end;


        
end;


      
end;


    
end;





  
end;


end;


end;





end.


FAQ Word / Excel

PREGUNTAS



¿Cómo mover el cursor hasta el final de un documento Word?

¿Cómo cambiar el tipo de letra de una celda?

¿Cómo cambiar el color de la tabla?

¿Cómo imprimir sin mostrar el cuadro de diálogo?

Cómo alinear texto en Word

Utilizar Excel a través de la interfaz COM

Utilizar Excel usando OLE

COMPROBAR SI OLE está instalado

¿Cómo exportar una tabla Word a un StringGrid?



RESPUESTAS



¿Cómo mover el cursor hasta el final de un documento Word?


Function EndOfDoc:boolean;


begin


EndOfDoc:=true;


try


W.ActiveDocument.Range.Select;


W.Selection.Start:=W.Selection.End;


except


EndOfDoc:=false;


end;


End;





¿Cómo cambiar el tipo de letra de una celda?




Function SelectCell(Table:integer;


Row,Column:integer):boolean;


begin


SelectCell:=true;


try


W.ActiveDocument.Tables.Item(Table).Columns.Item


 
(Column).Cells.Item(Row).Select;


except


SelectCell:=false;


end;


End;





Function FontToEFont(font:Tfont;EFont:variant;





ColorIndex:integer):boolean;


begin


FontToEFont:=true;


try


EFont.Name:=font.Name;


if
fsBold
in
font.Style


 
then
EFont.Bold:=True 


 
else
EFont.Bold:=False; 


if
fsItalic
in
font.Style


 
then
EFont.Italic:=True


 
else
EFont.Italic:=False; 


EFont.Size:=font.Size; 


if
fsStrikeOut
in
font.Style


 
then
EFont.Strikethrough:=True 


 
else
EFont.Strikethrough:=False; 


if
fsUnderline
in
font.Style


 
then
EFont.Underline:=wdUnderlineSingle 


 
else
EFont.Underline:=wdUnderlineNone; 


EFont.ColorIndex:=ColorIndex; 


except


FontToEFont:=false;


end;


End;





Cuando se selecciona un objeto, podemos cambiar la fuente, para ello utilizamos la siguiente función para la selección de objetos:




Function SetFontSelection(font:Tfont;


ColorIndex:integer):boolean;


begin


SetFontSelection:=true;


try


SetFontSelection:=FontToEFont(font,W.Selection.font,ColorIndex);


except


SetFontSelection:=false;


end;


End;





¿Cómo cambiar el color de la tabla?


W.ActiveDocument.Tables.Item(tab_).Columns.Item(col_).Cells.Item(row_).Borders.Item(wdBorderTop).ColorIndex:=wdDarkRed;





¿Cómo imprimir sin mostrar el cuadro de diálogo?




Function PrintOutDoc(NumCopies:integer):boolean;


begin


PrintOutDoc:=true;


try


W.ActiveDocument.PrintOut(NumCopies);


except


PrintOutDoc:=false;


end;





Cómo alinear texto




W.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;


W.Selection.ParagraphFormat.Alignment:=wdAlignParagraphRight;


W.Selection.ParagraphFormat.Alignment:=wdAlignParagraphJustify;





Utilizar Excel a través de la interfaz COM





EJEMPLO 1 




var
Excel, WorkBook, Sheet: Variant;


begin


Excel :=
CreateOleObject(
'Excel.Application');


Excel.WorkBooks.Open(FileName,False);


WorkBook
:= Excel.WorkBooks.Item[
1];


Sheet :=
Workbook.Sheets.Item[
3];


Sheet.Cells[1,2]:='ASDFG';


Sheet.Cells[2,2]:=230;





EJEMPLO 2


uses


ComObj,
ActiveX;





var


Row,
Col: integer;


DestRange: OleVariant;


Excel:
Variant;





begin


Excel :=
CreateOleObject(
'Excel.Application');


Excel.Visible := True;


Excel.WorkBooks.Add; 


Excel.ActiveSheet.Range['A2', 'B3'].Value := 'Тест';


Excel.ActiveSheet.Range['A4', 'B5'].Value := 42;


Excel.ActiveSheet.Range['A10', 'A11'].Formula := '=RAND()';


Excel.ActiveSheet.Cells.Item[1, 1].Value := 'prueba';





Row:=1;


Col:=3;


Excel.ActiveSheet.Cells.Item[Row, Col].Value := 'prueba';





DestRange := Excel.Range['D6', 'F10'];


Excel.Range['A1', 'C5'].Copy(DestRange);





Excel.Range['A2', 'A2'].Font.Size := 20;


Excel.Range['A2', 'A2'].Font.FontStyle := 'Bold';


Excel.Range['A2', 'A2'].Font.Color := clFuchsia;


Excel.Range['A2', 'A2'].Font.Name := 'Arial';


Excel.Range['B2', 'C6'].Interior.Color := RGB(223,
123, 123);


end;





EJEMPLO 3







uses


ComObj,
ActiveX;





var


Excel:
Variant;


WBk :
OleVariant;


SaveChanges: OleVariant;


begin


Excel :=
CreateOleObject(
'Excel.Application');


Excel.Visible := True;


WBk :=
Excel.WorkBooks.Open(
'C:\Test.xls');




...





WBk.Close(SaveChanges := True);


Excel.Quit;


end;








Utilizar Excel usando OLE







{


Ejemplo para imprimir un archivo utilizando OLE


}


uses


ComObj;





procedure TForm1.Button1Click(Sender: TObject);


var


ExcelApp: OLEVariant;


begin


//
Create an Excel instance


//
Excel Instanz erzeugen


ExcelApp
:= CreateOleObject(
'Excel.Application');


try


  
ExcelApp.Workbooks.Open(
'C:\test\xyz.xls');


  
// you can also modify
some settings from PageSetup


  
// Man kann auch noch
einige Einstellungen von "Seite Einrichten" anpassen


  
ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape;


  
// Print it out


  
// Ausdrucken


  
ExcelApp.Worksheets.PrintOut;


finally


  
// Close Excel


  
// Excel wieder
schliessen


  
if
not
VarIsEmpty(ExcelApp)
then


  
begin


    
ExcelApp.Quit;


    
ExcelApp := Unassigned;


  
end;


end;


end;  










//COMPROBAR SI OLE está instalado




if
not
IsOLEObjectInstalled(
'Excel.Application') then


  
ShowMessage(
'no instalado')


else


  
ShowMessage(
'instalado');








function IsOLEObjectInstalled(Name: String): boolean;


var


ClassID:
TCLSID;


Rez :
HRESULT;


begin





Rez :=
CLSIDFromProgID(PWideChar(WideString(
Name)), ClassID);





if
Rez = S_OK
then


  
Result := true


else


  
Result := false;


end;








¿Cómo exportar una tabla Word a un StringGrid?







uses


ComObj;





procedure TForm1.Button1Click(Sender: TObject);


const


AWordDoc
=
'C:\xyz\testTable.doc';


var


MSWord,
Table: OLEVariant;


iRows,
iCols, iGridRows, jGridCols, iNumTables, iTableChosen: Integer;


CellText: string;


InputString: string;


begin


try


  
MSWord := CreateOleObject(
'Word.Application');


except


  
// Error....


   Exit;


end;





try


  
MSWord.Visible := False;


  
MSWord.Documents.Open(AWordDoc);





  
// Get number of tables
in document


  
iNumTables := MSWord.ActiveDocument.Tables.Count;





  
InputString := InputBox(IntToStr(iNumTables) +


    
' Tables in Word
Document'
, 'Please Enter Table
Number'
, '1');


  
// Todo: Validate string
for integer, range...


  
iTableChosen := StrToInt(InputString);





  
// access table


   Table
:= MSWord.ActiveDocument.Tables.Item(iTableChosen);


  
// get dimensions of
table


   iCols
:= Table.Rows.Count;


   iRows
:= Table.Columns.Count;


  
// adjust stringgrid
columns


  
StringGrid1.RowCount := iCols;


  
StringGrid1.ColCount := iRows +
1;





  
// loop through cells


  
for
iGridRows :=
1
to
iRows
do


    
for
jGridCols :=
1
to
iCols
do


    
begin


      
CellText := Table.Cell(jGridCols, iGridRows).Range.FormattedText;


      
if
not
VarisEmpty(CellText)
then


      
begin


        
// Remove Tabs


        
CellText := StringReplace(CellText,


           #$D, '',
[rfReplaceAll]);


        
// Remove linebreaks


        
CellText := StringReplace(CellText, #$7,
'',
[rfReplaceAll]);





        
// fill Stringgrid


        
Stringgrid1.Cells[iGridRows, jGridCols] := CellText;


      
end;


    
end;


  
//..


finally


  
MSWord.Quit;


end;


end;





































Simulación del movimiento de los electrones en un campo electrico

Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico. Como muestra la image...