在Delphi XE7中使用Outlook联系人

时间:2016-01-02 11:33:11

标签: delphi outlook

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

我发现了几个例子,似乎都过时或有缺陷。

目前我有以下代码,但是当我在运行时执行该命令时,我得到以下错误:

代码:

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'.

在抛出错误之前,项目没有通过以下代码。

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

是否有一种有效的方法可以将Outlook中导入的所有联系人列表添加到备忘录中?

1 个答案:

答案 0 :(得分:0)

也许它的区分大小写?我测试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;是我们维护的一些私人财产 这个代码必不可少的是它首先执行GetActiveOleObject来捕获正在运行的Outlook实例;如果失败,则执行CreateOleObject