Создать новый Outlook Contact?
Материал из DRKB
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;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04444