Delphi 如何使用MAPI程序检索outlook配置文件的组邮箱名称?
有没有办法通过扩展MAPI程序为特定outlook配置文件检索添加的组邮箱名称?我强烈建议使用它,您可以从Delphi使用COM调用它。Redemption附带profman.dll,可让您访问Outlook配置文件 以下是几年前我使用的一些VBS代码示例,用于将所有添加的邮箱转储到xml文件(转换为Delphi应该不太难): 你需要Delphi 如何使用MAPI程序检索outlook配置文件的组邮箱名称?,delphi,outlook,mapi,Delphi,Outlook,Mapi,有没有办法通过扩展MAPI程序为特定outlook配置文件检索添加的组邮箱名称?我强烈建议使用它,您可以从Delphi使用COM调用它。Redemption附带profman.dll,可让您访问Outlook配置文件 以下是几年前我使用的一些VBS代码示例,用于将所有添加的邮箱转储到xml文件(转换为Delphi应该不太难): 你需要 调用MAPIAdminProfiles以检索IProfAdmin 指定配置文件名称调用IProfAdmin.AdminServices(返回ImsgService
您可以在中查看数据并使用它(单击IProfAdmin或IMAPISession | AdminServices)。您的代码在哪里运行?您是否已经有活动的MAPI会话?或者你只知道档案名称?我有“档案名称”。我想获取使用扩展MAPI程序在Delphi中与特定配置文件链接的所有组邮箱名称。是否将“链接”添加到Exchange提供程序选项对话框中的“打开这些其他邮箱”中?或当前用户有权打开的邮箱列表?邮箱位于“打开这些其他邮箱”选项下。
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