空き時間情報のみの権限を持つ予定表のアイテム数を取得する方法


コメントにて以下のご要望をいただきました。


はじめまして。Outlookマクロについて頼れるサイトとして、こちらのサイトで学んでいます。
Outlookのマクロで簡単にできそうなことで行き詰っています。
1 共有を得ていない方の予定表の一定期間のアイテム数を取得したいのですが、共有している場合は簡単に取得できるのに、うまくいきません。方法はあると思うのですが。
2 次善の手段として、予定表でステイタスバーに表示される「ビューのアイテム数」を取得したいのですが、これもわかりません。どのオブジェクトの何ていうプロパティか、教えてください。
1でも2でも、ご教示頂けると助かります。是非ともよろしくお願いします。


「空き時間情報、件名、場所」の権限がある他のユーザーの予定を一括で表示するマクロの記事で説明している通り、Exchange 環境でフォルダーのアクセス権限が「空き時間情報、件名、場所」となっている場合、EWS でアクセスする必要があります。
引数として取得したいユーザーのアドレスと開始日、終了日を指定すると、予定の件数を取得する関数を作りました。
EWS_URL には Exchange サーバーの EWS の URL を指定します。
また、 GetFreeBusyCountTest は動作を説明するためのサンプルになります。

' ここをトリプルクリックでマクロ全体を選択できます。
'
Private Function GetFreeBusyCount(strUser As String, dtStart As Date, dtEnd As Date) As Integer
    On Error Resume Next
    ' EWS の URL を指定します。
    Const EWS_URL = "https://casserver.example.com/ews/exchange.asmx"
    Dim xmlHttp
    Dim strXmlData As Variant
    Dim strStart As String
    Dim strEnd As String
    Dim xmlDoc
    Dim i As Integer
    ' EWS リクエスト生成
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    strXmlData = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
        "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance""" & _
        " xmlns:xsd=""http://www.w3.org/2001/XMLSchema""" & _
        " xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/""" & _
        " xmlns:t=""http://schemas.microsoft.com/exchange/services/2006/types"">" & _
        "<soap:Body>" & _
        "<GetUserAvailabilityRequest xmlns=""http://schemas.microsoft.com/exchange/services/2006/messages""" & _
        " xmlns:t=""http://schemas.microsoft.com/exchange/services/2006/types"">" & _
        "<t:TimeZone xmlns=""http://schemas.microsoft.com/exchange/services/2006/types"">" & _
        "<Bias>-540</Bias>" & _
        "<StandardTime><Bias>0</Bias><Time>00:00:00</Time><DayOrder>0</DayOrder><Month>0</Month><DayOfWeek>Sunday</DayOfWeek></StandardTime>" & _
        "<DaylightTime><Bias>-60</Bias><Time>00:00:00</Time><DayOrder>0</DayOrder><Month>0</Month><DayOfWeek>Sunday</DayOfWeek></DaylightTime>" & _
        "</t:TimeZone>" & _
        "<MailboxDataArray>"
    ' 取得するメールボックスを追加
    strXmlData = strXmlData & _
        "<t:MailboxData><t:Email><t:Address>" & strUser & "</t:Address></t:Email>" & _
        "<t:AttendeeType>Required</t:AttendeeType><t:ExcludeConflicts>false</t:ExcludeConflicts>" & _
        "</t:MailboxData>"
    ' 取得する期間を設定
    strStart = Format(dtStart, "yyyy-mm-ddThh:nn:ss")
    strEnd = Format(dtEnd, "yyyy-mm-ddThh:nn:ss")
    strXmlData = strXmlData & _
        "</MailboxDataArray>" & _
        "<t:FreeBusyViewOptions>" & _
        "<t:TimeWindow>" & _
        "<t:StartTime>" & strStart & "</t:StartTime>" & _
        "<t:EndTime>" & strEnd & "</t:EndTime>" & _
        "</t:TimeWindow>" & _
        "<t:MergedFreeBusyIntervalInMinutes>60</t:MergedFreeBusyIntervalInMinutes>" & _
        "<t:RequestedView>DetailedMerged</t:RequestedView>" & _
        "</t:FreeBusyViewOptions>" & _
        "</GetUserAvailabilityRequest>" & _
        "</soap:Body>" & _
        "</soap:Envelope>"
    ' リクエスト送信
    xmlHttp.Open "POST", EWS_URL, False ' , strDom & "\" & strUser, strPass
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.Send strXmlData
    If xmlHttp.Status = "200" Then
        Set xmlDoc = CreateObject("MSXML2.DOMDocument")
        If xmlDoc.LoadXML(xmlHttp.responseText) Then
            ' OK なら件数を取得
            Set arrFBResps = xmlDoc.DocumentElement.getElementsByTagName("FreeBusyResponse")
            GetFreeBusyCount = arrFBResps(0).getElementsByTagName("CalendarEvent").Length
            Exit Function
        End If
    End If
    ' エラーなら 0 件とする
    GetFreeBusyCount = 0
End Function
'
Public Sub GetFreeBusyCountTest()
    On Error GoTo ErrorHandler
    Dim strUser As String
    Dim strStart As String
    Dim dtStart As Date
    Dim strEnd As String
    Dim dtEnd As Date
    Dim cFreeBusy As Integer
    '
    strUser = InputBox("取得するユーザーのアドレス:")
    strStart = InputBox("開始日")
    dtStart = CDate(strStart)
    strEnd = InputBox("終了日")
    dtEnd = DateAdd("d", 1, CDate(strEnd))
    cFreeBusy = GetFreeBusyCount(strUser, dtStart, dtEnd)
    MsgBox "予定の件数は " & cFreeBusy & " 件です。"
    Exit Sub
ErrorHandler:
    MsgBox Err.Description
End Sub

マクロの登録方法やメニューへの追加について

広告

空き時間情報のみの権限を持つ予定表のアイテム数を取得する方法」への3件のフィードバック

  1. はじめまして。
    Flagのありという条件だけではなく、今日/今週/…のようにFlagの期限別に検索フォルダーを作製したいのですが、
    高度な検索機能のタブからFlagの期限を選んで指定してもうまくいきません。
    使用しているのはOutlook2010です。もしご存知でしたらお教えください。

    • 検索条件として「今日」や「今週」などを選んだ場合、実際に検索が実行されるタイミングで現在時刻から日付範囲が設定された検索となります。
      そのため、仮に検索フォルダーが作れたとしても、「今日が期限」の検索フォルダーを 10/10 に作成すれば、それは「10/10 が期限」の検索フォルダーとなってしまい、翌日になれば「昨日が期限」となります。
      [フラグの設定されたメール] 検索フォルダーのビューで [期限] によりグループ化してはどうでしょうか?

      • お返事いただきありがとうございます。
        ビューで期限ごとにグループ化して表示していたのですが、
        フォルダの横に表示される項目数を期限ごとに分けたかったので設定方法を探しておりました…。
        本日もう一度設定を探してみて、”フラグの期限”ではなく、なぜか”期限”を選ぶとうまくいくことがわかりました。
        ご検討いただきありがとうございました。

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中