予定表の共有招待を送信する
共有の招待、共有要求、共有応答などのメッセージの共有は、 SharingItem オブジェクトによって Microsoft Outlook で表されます。 NameSpace オブジェクトの CreateSharingItem メソッドは、招待と共有要求を共有するための SharingItem オブジェクトを作成するために使用されます。
この例では、OpenSharingItem メソッドを使用して、既定の予定表フォルダーの共有への招待を表す SharingItem を作成します。 共有されると、受信者は NameSpace オブジェクトの OpenSharedFolder メソッドまたは GetSharedDefaultFolder メソッド、または SharingItem オブジェクトの OpenSharedFolder メソッドを使用して共有フォルダーを開くことができます。
このサンプルでは、NameSpace オブジェクトの GetDefaultFolder メソッドを使用して、現在のユーザーの予定表の既定のフォルダーの Folder オブジェクト参照を取得します。
CreateSharingItem メソッドを使用して、新しい SharingItem オブジェクトを作成します。 SharingItem で使われる共有コンテキストを設定するために、 Folder オブジェクトを使用します。
最後に、新しく作成された SharingItem オブジェクトの Recipients コレクションの Add メソッドを呼び出して指定した受信者を追加し、Send メソッドを使用して SharingItem を送信します。
Public Sub ShareCalendarByInvitation()
Dim oNamespace As NameSpace
Dim oFolder As Folder
Dim oSharingItem As SharingItem
On Error GoTo ErrRoutine
' Get a reference to the Calendar default folder
Set oNamespace = Application.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
' Create a new sharing invitation, using the Calendar
' default folder to establish sharing context.
Set oSharingItem = oNamespace.CreateSharingItem(oFolder)
' Add a recipient to the Recipients collection of
' the sharing invitation.
oSharingItem.Recipients.Add "someone@example.com"
' Send the sharing invitation.
oSharingItem.Send
EndRoutine:
On Error GoTo 0
Set oSharingItem = Nothing
Set oFolder = Nothing
Set oNamespace = Nothing
Exit Sub
ErrRoutine:
Select Case Err.Number
Case 287 ' &H0000011F
' The user denied access to the Address Book.
' 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 -313393143 ' &HED520009
' This error typically occurs if you set the
' AllowWriteAccess property of a SharingItem
' to True when sharing a default folder.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case -2147467259 ' &H80004005
' This error typically occurs if the SharingItem
' cannot be sent because of incorrect or
' conflicting property settings.
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 のサポートおよびフィードバックを参照してください。