BorlandTalk.com

G. Bradley MacDonald · Guest

In article <3f4f7a4b (AT) newsgroups (DOT) borland.com>, [email]aohlsson (AT) borland (DOT) com[/email]
says...

Asaf · Guest

First place 2 contorls from the Servers VCL tab on your form:
TOutlookApplication
TContactItem

The below code is the code form my Form so you can take the code you need to
connect to outlook:
Best Regards,
Asaf

unit frmOutlookU;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Outlook2000, OleServer, CheckLst, ComCtrls,
ToolWin, ImgList, Menus, Grids, BaseGrid, AdvGrid, QExport, QExportXLS,
ShellAPI,
FormHints;

type
TfrmOutlook = class(TForm)
Panel1: TPanel;
GroupBox1: TGroupBox;
Outlook: TOutlookApplication;
Contact: TContactItem;
cbContactsFolders: TComboBox;
Panel2: TPanel;
GroupBox2: TGroupBox;
clbContacts: TCheckListBox;
ImageList1: TImageList;
ToolBar1: TToolBar;
tlbExit: TToolButton;
tlbHelp: TToolButton;
StatusBar1: TStatusBar;
Panel3: TPanel;
GroupBox4: TGroupBox;
GroupBox6: TGroupBox;
tlbSaveList: TToolButton;
ToolButton2: TToolButton;
tlbDistList: TToolButton;
strGridExcelNumbers: TAdvStringGrid;
strGridWrongNumbers: TAdvStringGrid;
tlbDeleteContact: TToolButton;
tlbClearGrids: TToolButton;
QExportXLS1: TQExportXLS;
tlbCreateNewDistList: TToolButton;
svDlgExcel: TSaveDialog;
tlbCheckList: TToolButton;
tlbUnCheckList: TToolButton;
ToolButton1: TToolButton;
FormHints1: TFormHints;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cbContactsFoldersCloseUp(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cbContactsFoldersChange(Sender: TObject);
procedure tlbExitClick(Sender: TObject);
procedure tlbDistListClick(Sender: TObject);
procedure tlbDeleteContactClick(Sender: TObject);
procedure tlbClearGridsClick(Sender: TObject);
procedure tlbSaveListClick(Sender: TObject);
procedure tlbCreateNewDistListClick(Sender: TObject);
procedure tlbCheckListClick(Sender: TObject);
procedure tlbUnCheckListClick(Sender: TObject);
procedure tlbHelpClick(Sender: TObject);
private
ContactsFolder, otlFolders: MAPIFolder;
NmSpace: NameSpace;
otlFolderEntryID, otlFolderStoreID: array of WideString;
SortedItems: Items;
function CheckValidNumber(sPhoneNumber: string): Boolean;

{ Private declarations }
public
{ Public declarations }
end;

var
frmOutlook: TfrmOutlook;
flgFixedRowAdded: Boolean = false;
implementation

uses frmMainU, ToolsU;

{$R *.dfm}

procedure TfrmOutlook.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Contact.Disconnect;
NmSpace.Logoff;
Outlook.Quit;

Self.Release;
end;

procedure TfrmOutlook.FormCreate(Sender: TObject);
var
i: integer;
begin
strGridExcelNumbers.ColWidths[1] := 175;
strGridWrongNumbers.ColWidths[1] := 175;

Outlook.Connect;
NmSpace := Outlook.GetNamespace('MAPI');
NmSpace.Logon('', '', False, False);

ContactsFolder := NmSpace.GetDefaultFolder(olFolderContacts);

// cbContactsFolders.Items.Add(ContactsFolder.Folders.Item(1).Name)

SetLength(otlFolderEntryID, ContactsFolder.Folders.Count +1);
SetLength(otlFolderStoreID, ContactsFolder.Folders.Count +1);

cbContactsFolders.Items.Add('øàùé');
for I := 1 to ContactsFolder.Folders.Count do
begin
cbContactsFolders.Items.Add(ContactsFolder.Folders.Item(i).Name);
otlFolderEntryID[i] := ContactsFolder.Folders.Item(i).EntryID;
otlFolderStoreID[i] := ContactsFolder.Folders.Item(i).StoreID;
end;

//Move 'øàùé' to be the first in the list after the sort
cbContactsFolders.Items.Move(cbContactsFolders.Items.IndexOf('øàùé'),0);
cbContactsFolders.ItemIndex := 0;
cbContactsFolders.OnChange(Self);
end;

procedure TfrmOutlook.cbContactsFoldersChange(Sender: TObject);
var
i: Integer;
begin
GroupBox2.Caption := 'øùéîú àðùé ÷ùø ìúé÷éä: ' + cbContactsFolders.Text;
clbContacts.Clear;
if (cbContactsFolders.ItemIndex = 0) then
otlFolders := ContactsFolder
else
begin
//for i := Low(otlFolderEntryID) to High(otlFolderEntryID) do
for i := 1 to ContactsFolder.Folders.Count do
begin
if (ContactsFolder.Folders.Item(i).Name = cbContactsFolders.Text) then
otlFolders := ContactsFolder.Folders.Item(i);
end;
end;
//otlFolders := ContactsFolder.Folders.Item(cbContactsFolders.ItemIndex);
//otlFolders :=
NmSpace.GetFolderFromID(otlFolderEntryID[cbContactsFolders.ItemIndex],
//otlFolderStoreID[cbContactsFolders.ItemIndex]);

{
otlFolders := ContactsFolder.Folders.Item(2);
ShowMessage(otlFolders.Name);
ContactsFolder := NmSpace.GetFolderFromID(otlFolders.EntryID,
otlFolders.StoreID);
}

//otlFolders.Items.Sort('[LastName]', 1);
SortedItems := otlFolders.Items;
SortedItems.Sort('[FirstName]', 2);

{
for i := 1 to otlFolders.Items.Count do
clbContacts.Items.Add((otlFolders.Items.Item(i) as ContactItem).FirstName
+
' ' + (otlFolders.Items.Item(i) as ContactItem).LastName +
' ' + (otlFolders.Items.Item(i) as ContactItem).MobileTelephoneNumber);
clbContacts.Sorted := True; // do this once after the names are added, for
speed
}

for i := 1 to SortedItems.Count do
clbContacts.Items.Add((SortedItems.Item(i) as ContactItem).FirstName +
' ' + (SortedItems.Item(i) as ContactItem).LastName +
' ' + (SortedItems.Item(i) as ContactItem).MobileTelephoneNumber);
// clbContacts.Sorted := True; // do this once after the names are added,
fo

// ContactNamesCombo.ItemIndex := 0;
//LoadComboItem;
end;

procedure TfrmOutlook.tlbExitClick(Sender: TObject);
begin
Self.Close;
end;

procedure TfrmOutlook.tlbDistListClick(Sender: TObject);
var
I, iIndex: Integer;
grdFind: TPoint;
strName, strMobile: string;
saveCursor: TCursor;
begin
//strGridExcelNumbers.RowCount := strGridExcelNumbers.RowCount + 1;
//strGridExcelNumbers.ColWidths[1] := strtoint(edit1.text);
saveCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
for I := 0 to clbContacts.Items.Count - 1 do
begin
if clbContacts.Checked[i] then
begin
iIndex := I + 1;
strMobile := (SortedItems.Item(iIndex) as
ContactItem).MobileTelephoneNumber;
strName := (SortedItems.Item(iIndex) as ContactItem).FirstName + ' ' +
(SortedItems.Item(iIndex) as ContactItem).LastName;
if not CheckValidNumber(strMobile) then
begin
with strGridWrongNumbers do
begin
grdFind := FindFirst(strName, []); //There is no need for settings
if not (grdFind.x>=0) then
begin
RowCount := RowCount +1;
Cells[0, RowCount - 1] := strMobile;
Cells[1, RowCount - 1] := strName;
end;
end;
end
else
begin
with strGridExcelNumbers do
begin
grdFind := FindFirst(strMobile, []); //There is no need for
settings
if not (grdFind.x>=0) then
begin
RowCount := RowCount +1;
Cells[0, RowCount - 1] := strMobile;
Cells[1, RowCount - 1] := strName;
end;
end;
end;
end;
end;

if not flgFixedRowAdded then
begin
with strGridExcelNumbers do
begin
if (RowCount <> 1) then
begin
FixedRows := 1;
Cells[0,0] := 'ñìåìàøé';
Cells[1,0] := 'ðîòï';
SortByColumn(1);
end;
end;

with strGridWrongNumbers do
begin
if (RowCount <> 1) then
begin
FixedRows := 1;
Cells[0,0] := 'ñìåìàøé';
Cells[1,0] := 'ðîòï';
SortByColumn(1);
end;
end;
end;
finally
Screen.Cursor := saveCursor;
end; // try/finally
end;

end.

"G. Bradley MacDonald" <bradley_A (AT) T_telus_DOT (DOT) _net> wrote

G. Bradley MacDonald · Guest

Thank you for the code!!