OutlookのVBAで別アカウントからSCHEDULEを送付したい

Question

エクセルVBAでOutlookからSCHEDULEを送付したいのですが、複数のアカウントを登録しており、[e-mail]であれば送付はできるのですが、[e-mail]の別アカウントに切り替えて送りたいと考えています。SendUsingAccount だと予定表に紐づかないのでどうすれば良いか悩んでおります。以下をどのように修正すればよいかアドバイスいただけますと大変助かります。何卒よろしくお願いいたします。

Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem  As AppointmentItem
Dim checkFlg As Long

checkFlg = 0


Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long


Dim strStart As String
Dim strEnd As String
Dim intKikan As Integer



strStart = Format(DateAdd("m", -intKikan, Date), "yyyy/mm/dd") 
strEnd = Format(DateAdd("m", intKikan, Date), "yyyy/mm/dd") 


 Application.ScreenUpdating = False


Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)

wsSheet.Activate

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items


Set olConItems = olConItems.Restrict("[Start] >= '" & strStart & "' And [End] < '" & strEnd & "'")



lnContactCount = 2

Dim rc As Integer
rc = MsgBox("会議出席依頼を送信しますか？", vbYesNo + vbQuestion, "確認")

If rc = vbYes Then

    For i = lnContactCount To Cells(1, 1).End(xlDown).Row
        Set olItem = olApp.CreateItem(olAppointmentItem)

       
        For Each olItemBefor In olConItems
            If TypeName(olItemBefor) = "AppointmentItem" Then
            
             
                If olItemBefor.EntryID = Cells(i, 9) Then
                
                  
                    With olItem
                        .Subject = Cells(i, 1)
                        .Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
                        .End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
                    End With

                
                   
                     checkFlg = 1
                
                 
                    If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then


                    Else

                        
                        If Cells(i, 10) <> "True" Then
                             With olItemBefor
                                .Subject = Cells(i, 1)
                                .Location = Cells(i, 2)
                                .Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
                                .End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
                                .Body = Cells(i, 5)
                                .RequiredAttendees = Cells(i, 7)
                                .OptionalAttendees = Cells(i, 8)
                                .Recipients.ResolveAll
                                
                                .MeetingStatus = 1 
                                .Send  '送信
                            End With
                        End If
                    End If
                    
                    'Null out the variables.
                    Set olItem = Nothing
                    
                End If
            End If
        Next
     
        If checkFlg <> 1 And Cells(i, 9) = "" Then
            With olItem
                .SendUsingAccount = Session.Accounts(Cells(2, 10).Value)   
                .Subject = Cells(i, 1)
                .Location = Cells(i, 2)
                .Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
                .End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
                .Body = Cells(i, 5)
                .RequiredAttendees = Cells(i, 7)
                .OptionalAttendees = Cells(i, 8)
                .Recipients.ResolveAll
                .MeetingStatus = 1
                .Send

           End With
           


          
           Cells(i, 9) = olItem.EntryID

           
        End If

Comments

[jinoji]

予定表に紐づかない、とはどういう挙動を指しますか？
.Send の代わりに .Displayにしたらどういう状態で表示されますか？

なお、コードはベタ貼りではなく「コードの挿入」を使っていただけると読みやすくなります。

[nobu0377]

Outlookの追加したアカウント（[e-mail]）の予定表にスケジュールが入らない状況です。もともとのアカウントにははいるのですが。調べると DeliveryStore プロパティから取得した Store オブジェクトの GetDefaultFolder メソッドを使うとうまくいくようですが、なかなかうまくいかず。アドバイスいただけますと幸いです。

[nobu0377]

また、ご指摘ありがとうございました！

Answer 1

Outlook の会議出席依頼は予定表に予定がある状態を前提とし、その予定から会議出席依頼が生成されます。
そして、会議出席依頼の送信者は開催者であり、その会議出席依頼のもとになった予定が格納されている予定表の持ち主となります。
したがって、自分以外のアカウントで会議出席依頼を送信したいのであれば、まずそのアカウントの予定表に予定を作成し、そこから会議出席依頼を送信する必要があります。

他のユーザーの予定表に予定を作成するには、以下のいずれかの方法で他のユーザーの予定表フォルダーを取得し、そのフォルダーの Items.Add メソッドで予定アイテムを追加します。
・GetSharedDefaultFolder メソッドで取得する
・そのユーザーのアカウントの Account オブジェクトの DefaultStore の GetDefaultFolder メソッドで取得する