Create Outlook Contact

uses ExtCtrls, ComObj, FileCtrl

type
  TContact = record
    LastName: string;
    FirstName : string;
    Company : string;
  end;
  
//

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;

// Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
var
  Directory: string;
  Contact : TContact;
begin
  try
    if SelectDirectory('Select directory', '', Directory) then
    Edit1.Text := Directory;

    Contact.LastName := Edit2.Text;  // Vorname
    Contact.FirstName := Edit3.Text; // Nachname
    Contact.Company := Edit4.Text;   // Firma

    OutlookAddContact(Directory, Contact);
  except
  ShowMessage('Error');
  end;
end;