Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Создать новый контакт в Outlook

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

Горе ты мое, аутлуковое...

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;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.