| Код | 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; |
--------------------
Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам... |
Создать новый Outlook Contact? 
Загрузка ...
