Outlook中添加联系人

Michael Klemm ： http://www.swissdelphicenter.ch/torry/showcode.php?id=1845

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;