如何使用 MAPI 程序检索 Outlook 配置文件的组邮箱名称？答案

【问题标题】：How to retrive Group mail box names for outlook profile using MAPI program?如何使用 MAPI 程序检索 Outlook 配置文件的组邮箱名称？
【发布时间】：2022-04-29 12:02:43
【问题描述】：

有没有办法通过扩展 MAPI 程序为特定 Outlook 配置文件检索添加的组邮箱名称？

【问题讨论】：

您的代码在哪里运行？您是否已经有一个活动的 MAPI 会话？还是您只知道个人资料名称？
我拥有“个人资料名称”。我想使用扩展 MAPI 程序获取与 Delphi 中特定配置文件链接的所有组邮箱名称。
"linked" 添加到 Exchange 提供程序选项对话框中的“打开这些附加邮箱”中？还是当前用户有权打开的邮箱列表？
“打开这些附加邮箱”选项下的邮箱。

标签： delphi outlook mapi

【解决方案1】：

我强烈建议您使用Outlook Redemption，您可以使用 Delphi 的 COM 调用它。 Redemption 附带 profman.dll，可让您访问 Outlook 配置文件。

这是我几年前用来将所有添加的邮箱转储到 xml 文件的一些示例 VBS 代码（转换到 Delphi 应该不会太难）：

Option Explicit

Dim fso, WshShell
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
WshShell.CurrentDirectory = fso.GetParentFolderName(WScript.ScriptFullName)

' Load TXMLDocument Class
Include("XMLClass.vbs")

' MAPI constanten
Const PR_DISPLAY_NAME = &H3001001E
Const PR_DISPLAY_NAME_W = &H3001001F
Const PR_MDB_PROVIDER = &H34140102
Const PR_PROFILE_HOME_SERVER = &H6602001E
Const PR_PROFILE_HOME_SERVER_DN = &H6612001E
Const PR_PROFILE_MAILBOX = &H660B001E
Const PR_PROFILE_SERVER = &H660C001E
Const PR_PROFILE_SERVER_DN = &H6614001E
Const PR_PROFILE_UNRESOLVED_NAME = &H6607001E
Const PR_PROFILE_UNRESOLVED_SERVER = &H6608001E
Const PR_PROFILE_USER = &H6603001E
Const PR_PST_PATH = &H6700001E
Const PR_SERVICE_UID = &H3D0C0102
Const PR_STORE_PROVIDERS = &H3D000102

' GUID constanten
Const MailboxGuid = "13DBB0C8AA05101A9BB000AA002FC45A"
Const pbExchangeProviderDelegateGuid = "9EB4770074E411CE8C5E00AA004254E2"

' omgevingsspecifieke gegevens
Const cHomeFolder = "U:\"

' public variabelen
Public objProfiles, objProfile, objServices, objExchService

' XML Object
Dim  xmlDoc
Set xmlDoc = New TXMLDocument
xmlDoc.Create("delegateMailboxes")

'Profman object aanmaken (profman.dll, moet in de c:\windows\system32 map staan, registreren met regsvr32)
Set objProfiles = CreateObject("ProfMan.Profiles")

' Open Default Outlook Profile
Set objProfile = objProfiles.DefaultProfile

Set objServices = objProfile.Services

' Zoek Exchange Service
Dim ServiceIndex, objService, objProviders, ProviderIndex, objProvider, objProfSect
For ServiceIndex = 1 To objServices.Count
   Set objService = objServices.Item(ServiceIndex)

   If objService.ServiceName = "MSEMS" Then
      Set objProviders = objService.Providers

      For ProviderIndex = 1 To objProviders.Count
         Set objProvider = objProviders.Item(ProviderIndex)
         Set objProfSect = objProvider.ProfSect

         ' Gekoppelde mailboxen gebruiken de Exchange Delegate Provider
         If objProfSect.Item(PR_MDB_PROVIDER) = pbExchangeProviderDelegateGuid Then 
            xmlDoc.AddRecord("delegateMailbox")
            Call xmlDoc.AddElement("PR_DISPLAY_NAME", objProvider.DisplayName)
            Call xmlDoc.AddElement("PR_DISPLAY_NAME_W", objProvider.DisplayName)           
            Call xmlDoc.AddElement("PR_PROFILE_MAILBOX", objProfSect.Item(PR_PROFILE_MAILBOX))
            Call xmlDoc.AddElement("PR_PROFILE_SERVER", objProfSect.Item(PR_PROFILE_SERVER))
            Call xmlDoc.AddElement("PR_PROFILE_SERVER_DN", objProfSect.Item(PR_PROFILE_SERVER_DN))
         End If   

      Next

   End If

Next

xmlDoc.SaveFormatted(cHomeFolder & "\delegateMailboxes.xml")
xmlDoc.Free
Set xmlDoc = Nothing

WScript.Quit(0)

Function Include (Scriptname)
   Dim fso, objFile
   Err.Clear
   Set fso = CreateObject("Scripting.FileSystemObject")
   Scriptname = fso.GetParentFolderName(WScript.ScriptFullName) & "\" & Scriptname

'    WScript.Echo("Including " & Scriptname)  
   Set objFile = fso.OpenTextFile(Scriptname)
   ExecuteGlobal(objFile.ReadAll())
   objFile.Close
   Include = Err.Number
End Function

【讨论】：

【解决方案2】：

你需要

调用 MAPIAdminProfiles 以检索 IProfAdmin
调用 IProfAdmin.AdminServices 指定配置文件名称（取回 ImsgServiceAdmin）
使用 PR_SERVICE_NAME == "MSEMS" 查找服务（可以有多个）。
调用 IMsgService.AdminProviders
查找“EMSDelegate”提供商。

您可以在OutlookSpy（我是它的作者）中查看数据并使用它 - 单击 IProfAdmin 或 IMAPISession |管理服务。

【讨论】：