在Delphi XE7中使用Outlook联系人 [英] Using Outlook Contacts In Delphi XE7

问题描述

我正在尝试使用delphi获取所有Outlook联系人的列表.

I am trying to get a list of all outlook contacts using delphi.

我发现了一些例子，似乎都过时或有缺陷.

I found a couple of examples, all seemed to be outdated or flawed.

当前我有以下代码，但是当我在运行时执行命令时，出现以下错误:

Currently I have the following code, but when I excecute the command at runtime I get the below error:

代码:

procedure Tinvite_friends.BitBtn2Click(Sender: TObject);
const
  olFolderContacts = $0000000A;
var
  outlook, NameSpace, Contacts, Contact: OleVariant;
  i: Integer;
begin
  Try
   outlook:=GetActiveOleObject('Outlook.Application');
  Except
    outlook:=CreateOleObject('Outlook.Application');
  End;
  NameSpace := outlook.GetNameSpace('MAPI');

  Contacts := NameSpace.GetDefaultFolder(olFolderContacts);
  for i := 1 to Contacts.Items.Count do
  begin
    Contact := Contacts.Items.Item(i);
    {now you can read any property of contact. For example, full name and
     email address}
    ShowMessage(Contact.FullName + ' <' + Contact.Email1Address + '>');
  end;

  Outlook := UnAssigned;
end;

错误消息:

Project appname.exe raised exception class EOLeSysError with message 'Invalid class string'.

在引发错误之前，该项目未通过以下代码.

The project does not get passed the below code before throwing the error.

Try
 outlook:=GetActiveOleObject('Outlook.Application');
Except
 outlook:=CreateOleObject('Outlook.Application');
End;

是否有一种有效的方法来获取从Outlook导入到备忘录中的所有联系人的列表?

Is there an effective way to get a list of all contacts from outlook imported to a memo for example?

推荐答案

也许区分大小写?我测试了outlook.application:

Maybe it's case sensitivity? I test for outlook.application:

const
  scxOutlookApp = 'outlook.application';
  scxNameSpace  = 'MAPI';

function TDataModuleSyncOutlook.ConnectToOutlook(AUserSMTP: String = ''): Boolean;
var
   lRecipient,
   lVar      : OleVariant;
   lLog,
   lLoginSMTP: String;
begin
   Result      := false;
   FWasCreated := False;  // Breakpoint 'Ignore subsequent exceptions' 
   try
      FOutlookApp := GetActiveOleObject(scxOutlookApp);         // Application object
      Result := True;
   except
      try
         FOutlookApp := CreateOleObject(scxOutlookApp);
         FWasCreated := True;
         Result := True;
      except
         on E:Exception do TSyncLogger.LogError(E.Message);
      end;
   end;
   if Result then          // Breakpoint 'Handle subsequent exceptions' 
   begin
      FNameSpace := FOutlookApp.GetNamespace(scxNameSpace);
      // Solution from http://stackoverflow.com/questions/18053110/retrieve-outlook-logged-in-user-smtp-address-after-connecting-through-ole/
      lLog := Format('Connected to Outlook; Application.DefaultProfilename: %s, Application.Name: %s, Application.Version: %s, NameSpace.CurrentProfileName: %s, NameSpace.ExchangeMailboxServerName: %s, NameSpace.Type: %s',
        [FOutlookApp.DefaultProfileName,
         FOutlookApp.Name,
         FOutlookApp.Version,
         FNameSpace.CurrentProfileName,
         FNameSpace.ExchangeMailboxServerName,
         FNameSpace.Type]);
      TSyncLogger.LogDetail(lLog);
      lVar := FOutlookApp.Session;                                   // NameSpace object for the current session
      if not VarIsClear(lVar) then lVar := lVar.CurrentUser;         // Recipient object for the currently logged-on user
      if not VarIsClear(lVar) then lVar := lVar.AddressEntry;        // AddressEntry object for the recipient
      if not VarIsClear(lVar) then lVar := lVar.GetExchangeUser;     // Returns an ExchangeUser object that represents the AddressEntry
      if not VarIsClear(lVar) then lVar := lVar.PrimarySmtpAddress;  // String representing the SMTP address for the ExchangeUser
      if not VarIsClear(lVar) then
      begin
         lLoginSMTP := FOutlookApp.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress;
         TSyncLogger.LogDetail('Primary Exchange SMTP address detected as: ' + lLoginSMTP);
      end
      else
      begin
         TSyncLogger.LogError(sErrNoExchangeAccount);
         DisConnectFromOutlook;
         Exit;
      end;
      if LowerCase(AUserSMTP) <> Lowercase(lLoginSMTP) then
      begin   // Open shared calendar if it's a different user
         lRecipient := FNameSpace.CreateRecipient(AUserSMTP);
         try
            FCalendarFolder := FNameSpace.GetSharedDefaultFolder(lRecipient, olFolderCalendar);
            lLog := Format('Logging in as different user (%s), created recipient for %s, GetSharedDefaultFolder folder path = %s',[AUserSMTP,lRecipient.Address,FCalendarFolder.FolderPath]);
            TSyncLogger.LogAlways(lLog);
         except
            on E:Exception do
            begin
               Result := false;
               TSyncLogger.LogError(Format(sErrOpenGedeeldeAgenda,[AUserSMTP]));
            end;
         end;
      end
      else   // ... otherwise open default calendar folder
      begin
         FCalendarFolder := FNameSpace.GetDefaultFolder(olFolderCalendar);
         TSyncLogger.LogDetail('Opened default calendar folder, folder path = ' + FCalendarFolder.FolderPath);
      end;
   end;
   FOleInitialized := Result;
   if Result then TSyncLogger.LogDetail('Connected to Outlook') else TSyncLogger.LogAlways('Connection to Outlook failed');
end;

注意:
1.这将为任何用户打开默认日历，但是您无需走那么远(此外，您的问题要早一些)
2. TSyncLogger是我们的日志记录处理程序
3. FOleInitialized, FWasCreated: Boolean; FOutlookApp, FNameSpace, FCalendarFolder: OleVariant;是我们维护的一些私有属性
4.此代码的本质是，它首先执行GetActiveOleObject来捕获正在运行的Outlook实例.如果失败，则会执行CreateOleObject

Notes:
1. This opens the default calendar for any user, but you would not need to go that far (besides, your issue is earlier)
2. TSyncLogger is our logging handler
3. FOleInitialized, FWasCreated: Boolean; FOutlookApp, FNameSpace, FCalendarFolder: OleVariant; are some private properties we maintain
4. Essential to this code is that it first does a GetActiveOleObject to catch a running instance of Outlook; if that fails it does a CreateOleObject

这篇关于在Delphi XE7中使用Outlook联系人的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！