使用 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 文件并将其导入到当前用户的“联系人”默认文件夹中。
之后,本示例获取对一个 NameSpace 对象的引用,然后调用该 NameSpace 对象的 GetSharedItem 方法以加载该 vCard 文件,并返回一个 ContactItem 引用。
接下来,本示例调用 ContactItem 的 Save 方法,以将其保存到 "联系人" 默认文件夹中。
最后,它通过使用 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 支持和反馈,获取有关如何接收支持和提供反馈的指南。