procedure TCreateFolderFrom.CreateBtnClick(Sender: TObject);
const
olFolderContacts = 10;
olContactItem = 2;
var
OutlookApp, Mapi,
NewContact, BorlandContacts,
ContactItems, CurrentContact: Variant;
I, ToRemove: Integer;
begin
OutlookApp := CreateOleObject('Outlook.Application');
Mapi := OutlookApp.GetNameSpace('MAPI');
ContactItems := Mapi.Folders('个人文件夹').Folders('联系人').Items;
{ 删除测试文件夹 }
ToRemove := 0;
for I := 1 to Mapi.Folders('Personal Folders').Folders.Count do
if Mapi.Folders('个人文件夹').Folders(I).Name ='Borland 联系人' then
begin
ToRemove := I;
Break;
end; // if
if ToRemove <> 0 then
Mapi.Folders('Personal Folders').Folders.Remove(ToRemove);
{ 创建新的文件夹 }
Mapi.Folders('个人文件夹').Folders.Add('Borland 联系人', olFolderContacts); //新增这一个联系人条目,写邮件时无法显示联系人组。
BorlandContacts := Mapi.Folders('Personal Folders').Folders('Borland Contacts');
{ 添加联系人到新的目录 }