Создать новый Outlook Contact?

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;

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...