会社でOutlook365で予定表を付けていますが、全社員の共有の予定表をOutlookで確認する代替手段として、Excelシートで確認したいニーズが出て、VBAマクロを作りました。(社員数は300人強)
基本的なコードは以下の通りですが、ループが100人を越えた時に、
『Microsoft Outlook:インフォメーション ストアを開けませんでした。』というエラーが
「GetSharedDefaultFolder」を呼び出した時に発生します。
※以下の★で "氏名101” を処理しようとしたタイミングです。(1つずれることもありますが)
VBA
1Sub TestGetAppointments() 2 Dim olApp As Outlook.Application 3 Dim olNms As Outlook.Namespace 4 Dim olRecip As Outlook.Recipient 5 Dim olFolder As Outlook.Folder 6 Dim olItem As Outlook.AppointmentItem 7 Dim sNames(), sName 8 On Error GoTo CATCH_ERROR 9 10 sNames = Array("氏名1", "氏名2", "氏名3" .... "氏名101" ... "氏名200") 11 Set olApp = New Outlook.Application 12 Set olNms = olApp.GetNamespace("MAPI") 13 For Each sName In sNames 14 Set olRecip = olNms.CreateRecipient(sName) 15 If Not olRecip.Resolve Then Err.Raise 65535, "olRecip.Resolve", "Unknown: " & sName 16 Set olFolder = olNms.GetSharedDefaultFolder(olRecip, olFolderCalendar) ★ 17 For Each olItem In olFolder.Items 18 Debug.Print olItem.Subject & "(" & olItem.Start & "-" & olItem.End & ")" 19 Next olItem 20 Set olFolder = Nothing 21 Set olRecip = Nothing 22 Next 23 Set olNms = Nothing 24 Set olApp = Nothing 25 Exit Sub 26 27CATCH_ERROR: 28 MsgBox "ERROR: " & Err.Source & ":" & Err.Description 29 Set olNms = Nothing 30 Set olApp = Nothing 31End Sub 32
一度に処理(CreateRecipient+GetSharedDefaultFolder)できる人数の上限といった制約があるものでしょうか?
仮にそうだとすると、Excelマクロを閉じて、開きなおして、再度実行する時は、"氏名101"から始めれば良さそうに思えますが、氏名101で同じエラーが起きます。
ということは、CreateRecipient+GetSharedDefaultFolderすると、Outlookの自分の予定表フォルダに他人の共有予定が取り込まれ、それが上限に達している状態で、それを解放しないと、それ以上の他人は取得できない(GetSharedDefaultFolderのエラーは解消しない)、ということでしょうか?だとした場合は、どうすれば解放できるでしょうか?
おわかりになる方にアドバイスいただけると助かります。
よろしくお願いいたします。
回答1件
あなたの回答
tips
プレビュー