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

Question

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

Answer 1

我强烈建议使用Outlook Redemption，您可以通过Delphi调用COM。兑换附带profman.dll，它允许您访问Outlook配置文件。

下面是一些例子VBS代码，我几年前用来转储全部添加邮箱到一个XML文件（转换为德尔福不要太用力）：

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 

Answer 2

您需要

1. 呼叫MAPIAdminProfiles检索IProfAdmin

2. 呼叫IProfAdmin.AdminServices指定的文件名（找回ImsgServiceAdmin）

3. 使用PR_SERVICE_NAME ==“MSEMS”查找服务（可以有多个）。

4. 呼叫IMsgService.AdminProviders

5. 查找 “EMSDelegate” 供应商。

你可以看到的数据，并在OutlookSpy发挥它（点击IProfAdmin或在IMAPISession | AdminServices）。