使用 OpenSharedItem 导入保存的项目

Microsoft Outlook 提供了用于 NameSpace 对象的 OpenSharedItem 方法,以便可以打开 iCalendar 约会 (.ics) 文件、vCard (.vcf) 文件和 Outlook 邮件 (.msg) 文件并返回与该文件相对应的 Outlook 项目。 此方法所返回对象的类型取决于所打开共享项目的类型,如下表所述。

共享项目类型 Outlook 项目
iCalendar 约会 (.ics) 文件 AppointmentItem
vCard (.vcf) 文件 ContactItem
Outlook 邮件 (.msg) 文件 类型对应于保存为 .msg 文件的项目的类型

打开共享项目之后,使用返回对象的 Save 方法即可导入该项目,以将其保存到与该 Outlook 项目相对应的默认文件夹中。

本示例首先会打开一个 vCard 文件并将其导入到当前用户的“联系人”默认文件夹中。

  1. 之后,本示例获取对一个 NameSpace 对象的引用,然后调用该 NameSpace 对象的 GetSharedItem 方法以加载该 vCard 文件,并返回一个 ContactItem 引用。

  2. 接下来,本示例调用 ContactItemSave 方法,以将其保存到 "联系人" 默认文件夹中。

  3. 最后,它通过使用 NameSpace 对象的 GetDefaultFolder 方法获取对当前用户的联系人默认文件夹的 Folder 对象引用,然后显示该文件夹。

Public Sub OpenSharedContact() 
 
 Dim oNamespace As NameSpace 
 Dim oSharedItem As ContactItem 
 Dim oFolder As Folder 
 
 On Error GoTo ErrRoutine 
 
 ' Get a reference to a NameSpace object. 
 Set oNamespace = Application.GetNamespace("MAPI") 
 
 ' Open the vCard (.vcf) file containing the shared item. 
 Set oSharedItem = oNamespace.OpenSharedItem( _ 
 "C:/SampleContact.vcf") 
 
 ' Save the item to the Contacts default folder. 
 oSharedItem.Save 
 
 ' Get a reference to and display the Contacts default folder. 
 Set oFolder = oNamespace.GetDefaultFolder( _ 
 olFolderContacts) 
 oFolder.Display 
 
EndRoutine: 
 On Error GoTo 0 
 Set oSharedItem = Nothing 
 Set oFolder = Nothing 
 Set oNamespace = Nothing 
Exit Sub 
 
ErrRoutine: 
 Select Case Err.Number 
 Case 287 ' &H0000011F 
 ' This error occurs if the code is run by an 
 ' untrusted application, and the user chose not to 
 ' allow access. 
 MsgBox "Access to Outlook was denied by the user.", _ 
 vbOKOnly, _ 
 Err.Number & " - " & Err.Source 
 Case -2147024894 ' &H80070002 
 ' Occurs if the specified file or URL could not 
 ' be found, or the file or URL cannot be 
 ' processed by the OpenSharedItem method. 
 MsgBox Err.Description, _ 
 vbOKOnly, _ 
 Err.Number & " - " & Err.Source 
 Case -2147352567 ' &H80020009 
 ' Occurs if the specified file or URL is not valid, 
 ' or you attempt to use the Move method on 
 ' an Outlook item that represents a shared item. 
 MsgBox Err.Description, _ 
 vbOKOnly, _ 
 Err.Number & " - " & Err.Source 
 Case Else 
 ' Any other error that may occur. 
 MsgBox Err.Description, _ 
 vbOKOnly, _ 
 Err.Number & " - " & Err.Source 
 End Select 
 
 GoTo EndRoutine 
End Sub

支持和反馈

有关于 Office VBA 或本文档的疑问或反馈? 请参阅 Office VBA 支持和反馈,获取有关如何接收支持和提供反馈的指南。