...create a new Outlook Contact?

Author: Michael Klemm

Category: Objects/ActiveX

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;

 

printed from
www.swissdelphicenter.ch
developers knowledge base