Gadget

Outlook の予定表を元にカレンダーを表示する Windows Vista サイドバー ガジェット

outlooklab Gadget

Outlook のカレンダー ナビゲータ (To Do バーに表示されている月単位のカレンダー) は、予定が入っている日付が太字で表示されるのですが、土曜日や日曜日、祝祭日などの色が変わりません。
ここのカスタマイズができないのか、というのは Outlook でよくある質問のひとつなのですが、Outlook 2007 でも色をつけるような機能は実現しませんでした。

しかし、Outlook のオブジェクト モデルを使ってカレンダー表示を行えば、Outlook に追加されている祝日などの情報を元に、色つきのカレンダーを表示することができます。Outlook Today にそのようなカレンダーを埋め込むという手もあるのですが、カレンダーはできれば常時表示されていた方が便利だと思いませんか?

そこで、Outlook の予定表の情報を元にカレンダーを表示する Windows Vista のガジェットを作ってみました。Windows Vista のガジェットは HTML やスクリプトの知識さえあれば結構簡単に作れるのです。
では、作り方の説明です。

  1. メモ帳を起動し、以下の内容を書き込み、outlookcal.html という名前で保存します。

    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
    <html>
    <head>
        <META HTTP-EQUIV="Content-Type" CONTENT="text/html;charset=Shift_JIS">
        <title></title>
    <STYLE>
    body{width:130px;height:125px;padding:5px;margin:0px;}
    #calendarpart{background-color:#ffffff;width:120px;height:115px; border:3px ridge orange;overflow:hidden;}
    // カレンダを 2 か月分表示する場合は下記の記述を使用
    // body{width:130px;height:225px;padding:5px;margin:0px;}
    // #calendarpart{background-color:#ffffff;width:120px;height:215px; border:3px ridge orange;overflow:hidden;}
    td{margin:0px;padding:0px;text-align:center;font-size:8pt;}
    td.f{font-weight:normal;color:black;width:16px;}
    td.b{font-weight:bold;color:black;width:16px;}
    td.sf{font-weight:normal;color:blue;width:16px;}
    td.sb{font-weight:bold;color:blue;width:16px;}
    td.hf{font-weight:normal;color:red;width:16px;}
    td.hb{font-weight:bold;color:red;width:16px;}
    table{
    margin:0px;
    }
    tr.hd{
    background-color:orange;
    }
    </STYLE>
    <SCRIPT LANGUAGE="VBScript">
    Option Explicit

    Dim g_strHtml
    Dim g_iYear
    Dim g_iMonth
    Const INTERVAL = 15 ' Outlook の予定表を確認する間隔 (分単位)

    Sub Body_OnLoad()
        g_iYear = Year(Now)
        g_iMonth = Month(Now)
       
        WriteMain
        window.setInterval "WriteMain",INTERVAL * 60 * 1000,"VBSCRIPT"
    End Sub

    Sub hrefPrev_OnClick()
        If g_iMonth = 1 Then
            g_iYear = g_iYear - 1
            g_iMonth = 12
        Else
            g_iMonth = g_iMonth - 1
        End If
        WriteMain
    End Sub

    Sub hrefNext_OnClick()
        If g_iMonth = 12 Then
            g_iYear = g_iYear + 1
            g_iMonth = 1
        Else
            g_iMonth = g_iMonth + 1
        End If
        WriteMain
    End Sub

    Sub OpenDate(iYear, iMonth, iDay)
        Dim appOutlook
        Dim nsSession
        Dim fldCalendar
        Dim viewDate
        Dim oExp
        Set appOutlook = CreateObject("Outlook.Application")
        Set nsSession = appOutlook.GetNamespace("MAPI")
        nsSession.Logon
        Set fldCalendar = nsSession.GetDefaultFolder(9)
        Set oExp = appOutlook.Explorers.Add(fldCalendar, 0)
        oExp.Display
        Set viewDate = fldCalendar.Views.Item("日/週/月")
        viewDate.Apply
        oExp.CurrentView.GoToDate iYear & "/" & iMonth & "/" & iDay
        Set viewDate = Nothing
        Set oExp = Nothing
        Set fldCalendar = Nothing
        Set nsSession = Nothing
        Set appOutlook = Nothing
    End Sub

    Sub DocumentWrite( strLine )
        g_strHtml = g_strHtml & strLine
    End Sub

    Sub WriteMain()
        Dim divCalendar
        Dim iNextYear
        Dim iNextMonth
        Set divCalendar = document.getElementById("CalendarPart")
        divCalendar.innerHtml = "Please Wait..."
       
        g_strHtml = ""
        DocumentWrite "<TABLE><TR class='hd'><TD><span id='hrefPrev' onclick='hrefPrev_OnClick()'>&lt;</span></TD>"
        DocumentWrite "<TD COLSPAN=5 width='80px'>" & g_iYear & "/" & g_iMonth & "</TD>"
        DocumentWrite "<TD><span id='hrefNext' onclick='hrefNext_OnClick()'>&gt;</span></TD></TR>"

        WriteCalendar g_iYear, g_iMonth

    '    カレンダーを 2 か月分表示する場合は、下記の記述のコメントを解除
    '    If g_iMonth = 12 Then
    '        iNextYear = g_iYear + 1
    '        iNextMonth = 1
    '    Else
    '        iNextYear = g_iYear
    '        iNextMonth = g_iMonth + 1
    '    End If
    '   
    '    DocumentWrite "<TABLE><TR class='hd'><TD COLSPAN=7 width='112px'>" & iNextYear & "/" & iNextMonth & "</TD></TR>"
    '   
    '    WriteCalendar iNextYear, iNextMonth
    '   
        divCalendar.innerHtml = g_strHtml
    End Sub

    Sub WriteCalendar( iYear, iMonth )
        Dim dtStart
        Dim dtEnd
        Dim dtNext
        Dim appOutlook
        Dim nsSession
        Dim colAppts
        Dim apptItem
        Dim spStart
        Dim spEnd
        Dim i
        Dim fBusy(31)
        Dim fHoliday(31)
        Dim strDesc(31)
        Dim wDay
        Dim strClass
        Dim bCheckToday
        DocumentWrite "<TR><TD class='hf'>日</TD><TD class='f'>月</TD><TD class='f'>火</TD><TD class='f'>水</TD><TD class='f'>木</TD><TD class='f'>金</TD><TD class='sf'>土</TD></TR>"

        dtStart = DateSerial(iYear,iMonth,1)
        dtNext = DateAdd("m",1,dtStart)
        dtEnd = DateAdd("d",-1,dtNext)
        bCheckToday = (dtStart <= Now) And (Now < dtNext)

        Set appOutlook = CreateObject("Outlook.Application")
        Set nsSession = appOutlook.GetNameSpace("MAPI")
        nsSession.Logon
        Set colAppts = nsSession.GetDefaultFolder(9).Items

        For i=1 To 31
            fBusy(i) = False
        Next

        For i=1 To 31
            fHoliday(i) = False
        Next

        colAppts.Sort "[開始日]", False
        colAppts.IncludeRecurrences = True
        Set colAppts = colAppts.Restrict("[終了日] >= '" & dtStart & " 0:00' and [開始日] < '" & dtNext & " 0:00'")
        For each apptItem in colAppts
            spStart = apptItem.Start
            If spStart < dtStart Then spStart = dtStart
            If spStart >= dtNext Then Exit For
            spEnd = apptItem.End
            If spEnd >= dtNext Then spEnd = dtNext
            If Hour(spEnd) = 0 And Minute(spEnd) = 0 Then
                spEnd = DateAdd("n",-1,spEnd)
            End If
            If apptItem.BusyStatus > 1 Then
                For i=Day(spStart) To Day(spEnd)
                    fBusy(i) = True
                    strDesc(i) = strDesc(i) & apptItem.Subject & vbCrLf
                Next
            End If
            If apptItem.Categories = "祝日" Then
                For i=Day(spStart) To Day(spEnd)
                    fHoliday(i) = True
                    strDesc(i) = strDesc(i) & apptItem.Subject & vbCrLf
                Next
            End If
        Next

        wDay = WeekDay(dtStart)-1

        If wDay > 0 Then
            DocumentWrite "<TR>"
            For i=1 to wDay
                DocumentWrite "<TD class='f'></TD>"
            Next
        End If

        For i=1 To Day(dtEnd)
            If fBusy(i) Then
                strClass = "b"
            Else
                strClass = "f"
            End If
            If fHoliday(i) Then
                strClass = "h" & strClass
            Else
                Select Case wDay
                    Case 0
                        strClass = "h" & strClass
                    Case 6
                        strClass = "s" & strClass
                End Select
            End If
            If wDay=0 Then
                DocumentWrite "</TR>"
            End If
            If bCheckToday And i = Day(Now) Then
                strClass = strClass & "' style='background-color:#c0c0c0;"
            End If
            DocumentWrite "<TD class='" & strClass & "' TITLE='" & strDesc(i) & "'>"
            DocumentWRite "<SPAN ondblclick='OpenDate " & iYear & "," & iMonth & "," & i & "'>" & i & "</SPAN></TD>"
            If wDay=6 Then
                DocumentWrite "</TR>"
            End If
            wDay = (wDay + 1) Mod 7
        Next
       
        If wDay > 0 Then
            For i=wDay to 6
                DocumentWrite "<TD class='f'></TD>"
            Next
            DocumentWrite "</TR>"
        End If

        DocumentWrite "</TABLE>"

        Set apptItem = Nothing
        Set colAppts = Nothing
        Set nsSession = Nothing
        Set appOutlook = Nothing
    End Sub
    </SCRIPT>

    </head>
    <body onload="Body_OnLoad()">
    <div id="CalendarPart"></div></body>
    </html>

  2. メモ帳を起動し、以下の内容を書き込み、gadget.xml という名前で保存します。

    <?xml version="1.0" encoding="shift_jis" ?>
    <gadget>
        <name>Outlook Calendar</name>
        <icons>
          <icon height="48" width="48" src="calendar.png" />
        </icons>
        <namespace>outlook.local</namespace>
        <version>1.0.0</version>
        <author name="Millefeuille">
            <info url="http://outlooklab.spaces.live.com" />
         <logo src="calendar.png" />
        </author>
        <copyright>2007</copyright>
        <description>Outlook の予定表を元にカレンダーを表示</description>
        <hosts>
            <host name="sidebar">
                <base type="HTML" apiVersion="1.0.0" src="outlookcal.html" />
                <permissions>full</permissions>
                <platform minPlatformVersion="0.3" />
            </host>
        </hosts>
    </gadget>

  3. ペイントを起動し、縦横ともに 48 ドットの適当な画像を作成し、calendar.png という名前で保存します。
  4. 新規の圧縮 (zip 形式) フォルダを作成し、名前を outlookcal.zip とします。
  5. 上記で作成した outlookcal.html、gadget.xml、calendar.png を outlookcal.zip にドラッグアンドドロップします。
  6. outlookcal.zip のファイル名を outlookcal.gadget に変更します。(拡張子に関する警告には [はい] を選択します。)
  7. outlookcal.gadget をダブルクリックします。
  8. [インストールする] をクリックします。

– ガジェットの使い方

このガジェットは 15 分間隔で Outlook の予定表をチェックし、予定が入っている日付を太字で表示します。また、土曜日は青、日曜日と祝祭日は赤で表示します。なお、祝祭日かどうかは Outlook の予定で [分類項目] が "祝日" になっているものがあるかどうかで判断しているため、国民の祝日ではない会社の祝日や自分で決めた休暇の日に [分類項目] が "祝日" となっている予定を書き込むことで赤く表示させることもできます。
ガジェットをクリックしてから太字になっている日付の上にマウスをポイントすると予定の件名がポップアップで表示されます。また、日付をダブルクリックすると Outlook でその日の予定が表示されます。
表示する月を変えたい場合は、カレンダー上部の < や > をクリックすると、それぞれ前月、次月に移動します。

ベースが HTML + スクリプトなので、カスタマイズは簡単に色々できると思います。(デザインをクールにしたり、色を変えたり、2 か月分表示したりなど。)
ぜひご活用ください。