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


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 か月分表示したりなど。)
ぜひご活用ください。

広告

Outlook の予定表を元にカレンダーを表示する Windows Vista サイドバー ガジェット」への41件のフィードバック

  1. すばらしいガジェットですね。
    早速使わせてもらおうと思ったのですが、手順通りにしてもうまく表示されません。
    もしよろしければgadgetファイルを直接いただけないでしょうか?

  2. WindowsXP+Outlook2000だと、何故か2008/12から、定期的な予定が開始日だけが見えるようになってしまいます(定期的な予定として表示されない状態)WindowsVista+Outlook2007だと大丈夫です。恐らくOutlookのバージョンによるものだと思うのですが、一応報告まで。

  3. Outlook 2000 での動作は確認していないのですが、おそらく Sort や Restrict でフィールド名として日本語を使っているためと考えられます。[開始日] を [Start]、[終了日] を [End] としてみてください。

  4. はじめまして。現在、VistにてOutlook2003で使用しています。大変気に入っています、ありがとうございます。そこで、1点質問なのですがガジェットからOutlook2003を立ち上げスケジュールを確認した後、終了するとインジケータにOutlookのアイコンが残り再度Outlookを起動しようとするとランタイムエラーになってしまい、タスクマネージャのプロセスからOutlook.exeを終了させなければいけません。何か解決策がありましたらお教え頂けないでしょうか。どうぞ宜しくお願いいたします。

  5. おおおっ!直りました^^ありがとうございます。※補足たいした問題ではないのですが前回のコードも今回のコードも、なぜか2008/12の時のみ「定期的ではない通常の予定」が表示されない事に気が付きました。ですが、2009/1からは正常動作するみたいなので、12月だけ我慢すれば特に問題なさそうです。

  6. ※さらに補足さらに2009/12でも「定期的ではない通常の予定」が表示されない事に気が付きました。なぜか12月が鬼門ですねぇ(汗)今度中身のコードを自分なりに調べてみようと思います。

  7. まとめて回答します。To タロウさん環境を用意して Outlook 2000 で確認しましたが、定期的でない予定が表示されないという現象は発生しませんでした。最新の SP や修正プログラムが適用されているかご確認ください。To ken 810 さんOutlook 2003 で試してみましたが Outlook のプロセスが残るという現象は再現できませんでした。最新の SP や修正プログラムが適用されているかご確認ください。

  8. 調査して頂いて、ありがとうございます。OfficeUpdateのWebページで、最新の状態にアップデート済みです。むむむ、何か設定上で問題があるのでしょうか…謎です。とりあえず、Googleデスクトップのほうのガジェットの「oCalendar」ではうまく表示される様ですが、WindowsサイドバーとGoogleサイドバーが共存出来ないので、どうしよう?とか思ってた所でした。http://www.bizon.org/ilya/ocalendar.htmこれのコードと見比べて自分なりに調べてみようと思います、ありがとうございました。

  9. Millefeuilleさん調査ありがとうございます。あれから私も色々と試してみました。前回のエラーメッセージこそ出なくなりましたが、ガジェットからOutlook2003を立ち上げスケジュールを確認した後終了するとタスクバー右のインジケータにOutlookのアイコンが残ったままになります。その状態で、再度ガジェットからOutlook2003を立ち上げようとしても反応せず、スタートメニューのプログラムからOutlookwo選択し立ち上げようとすると「操作は失敗しました。」というメッセージが出て立ち上がりません。一旦ガジェットでOutlookを呼び出した後、終了せずに常駐し使用し続ければ問題なく動作します。ちなみに、ご指摘の在った最新のSPおよび修正プログラムは最新のものにしております。終了せずに常駐して使用すれば問題ないので現在はこちらで使用しています。もう少しこちらで色々とやってみたいと思っています。もし何か良いアドバイス等、今後在りましたらお手数お掛けしますがよろしくお願いいたします。

  10. 出来ました~^^アイテムを取り出す条件の部分をoCalendarのコードからパクってみたら上手く行きました。変更点は以下の通りです。Sub WriteCalendar( iYear, iMonth ) Dim strFind // 追加 Dim dtStartちょっと下の行へ・・・ colAppts.Sort "[Start]", False // 変更 colAppts.IncludeRecurrences = True strFind = "[Start] > \’#" & dtStart & "#\’" // 追加 strFind = strFind & " AND [End] < \’#" & dtNext & "#\’" // 追加 Set colAppts = colAppts.Restrict(strFind) // 変更なぜこれで直るかはハッキリとは分からないですが、うまく行ったので良しとしましょう。後でMillefeuilleさんの件も調べてみようと思います。※予想としては呼び出したOutlookのActiveXを開放すれば直るのかな???この部分はまだ詳しく見てません

  11. ken 810さんの件も対応してみました。とは言うものの、不都合の再現が出来ていないので、これで大丈夫かどうかは不明です、試してみてもらえますか?oExp.CurrentView.GoToDate iYear & "/" & iMonth & "/" & iDaySet appOutlook = Nothing // 追加End Subちょっと下の行へ・・・DocumentWrite "</TABLE>"Set appOutlook = Nothing // 追加End Sub解説すると、OutlookのActiveXを呼び出しているSet appOutlook = CreateObject("Outlook.Application")に対し、開放するコードSet appOutlook = Nothingを追加してあります。本来はこれなくても自動的に開放するはずなのですが、いちおうお作法的には書いたほうが良いそうです。

  12. タロウ 様お世話になります。ken810です。ありがとうございます。下記の件、試してみました。結果は、変わらずでした...現象を上手く伝えられないのが歯がゆいにですが、諦めず調べてみます。ちなみに、OUTLOOK.EXEを直接叩いて起動した場合とガジェット上の日付をクリックして立ち上がったOutlookが何か別物のような気がします。そこで1点お教えください。「日付をダブルクリックすると Outlook でその日の予定が表示されます。」部分のスクリプトはどの部分になるのでしょうか?お手数おかけしますが、宜しくお願いいたします。

  13. ken810様>結果は、変わらずでした...あらら・・・残念(;_;)>「日付をダブルクリックすると Outlook でその日の予定が表示されます。」部分のスクリプトはどの部分になるのでしょうか?うう、自分も適当にかいつまんで修正しているだけなので、全体的にどんな動きになっているかはよく分かってなかったりします、力になれなくてごめんなさい><>ちなみに、OUTLOOK.EXEを直接叩いて起動した場合とガジェット上の日付をクリックして立ち上がったOutlookが何か別物のような気がします。これでちょっとピーンと来たのですが、そういえば昔DelphiでExcelのActiveX使ったときに、既に起動してるのを呼び出す関数があった気がしたなぁ~とか思って調べてみたら…ビンゴ!VBScriptではGetObjectという関数を発見しました。ただしコレ、既存のものが無い場合は使えないみたいなので、GetObjectでエラーが出たらCreateObject関数を使うというコードに変更してみました。※あとで確認のためにoCalendarのコードも見てみたらまさに同じ処理になってました。とりあえず前回の修正はそのままで以下を変更します Dim oExp On Error Resume Next //追加 Set appOutlook = GetObject("","Outlook.Application") //追加 If Err.Number <> 0 Then //追加 Set appOutlook = CreateObject("Outlook.Application") End If //追加 Err.Clear //追加 On Error Goto 0 //追加ちょっと下の行へ・・・ bCheckToday = (dtStart <= Now) And (Now < dtNext) On Error Resume Next //追加 Set appOutlook = GetObject("","Outlook.Application") //追加 If Err.Number <> 0 Then //追加 Set appOutlook = CreateObject("Outlook.Application") End If //追加 On Error Goto 0 //追加※前回書いた、以下のコード変更もしておいて下さい。oExp.CurrentView.GoToDate iYear & "/" & iMonth & "/" & iDaySet appOutlook = Nothing // 追加End Subちょっと下の行へ・・・DocumentWrite "</TABLE>"Set appOutlook = Nothing // 追加End Subどうでしょう?

  14. To タロウさん定期的でない予定が表示されなかったのは日付を # で囲っていなかったからなのですね。私の環境では # で囲まなくても日付として認識されたのですが、VBScript のバージョンによっては日付にならないということがあるのかもしれません。To ken 810さん日付をダブルクリックしたときの処理は Sub OpenDate になります。とりあえず、スクリプト内で参照した Outlook のオブジェクトをすべて Nothing にして明示的に開放するよう修正してみました。

  15. Millefeuilleさんタロウさんお世話になります。連絡有難うございます。まずは、Millefeuilleさんの修正点を反映してみました。そして、タロウさんの修正点も反映していました。結果は、なんとも言えない結果となりました。詳しく説明いたします。まず、ガジェットから日付をクリックしOutlookを起動します。その起動したOutlookを一旦終了いたします。(「ファイル」→「終了」)その後、再度Outlookを起動すると下記のエラーメッセージが表示され起動できなくなります。Millefeuilleさんの修正点反映時—–ランタイムエラーが発生しました。デバッグしますか?行:71エラー:操作は失敗しました。—–タロウさんの修正点反映時—–ランタイムエラーが発生しました。デバッグしますか?行:81エラー:操作は失敗しました。—–この後、タスクマネージャーでプロセスを見てみるとOutlook.exeが残ったままになっています。(通知領域のOutlookアイコンも残っています。)この、Outlook.exeを強制的に終了させると再度Outlookが起動するようになります。そこで、上記現象を回避する方法として1つ方法を見つけました。ガジェットからOutlookを起動した後、終了せずに再度ガジェットからOutlookを立ち上げます。この時点で、2つのOutlookのウインドウが立ち上がっています。ちなみにプロセス上は、1つのOutlook.exeしかありません。2つOutlookを両方とも終了します。(この時、通知領域に表示されているOutlookのアイコンを右クリックし「Outlookを開く」の項目を見てみると2つの予定表が存在しています。ただしこの予定表を選択し開こうとしても開くことは無く無反応です。)上記2つのOutlookを立ち上げ、その後終了した後は何のエラーも出ず日付をクリックすれば問題も無くOutlookが立ち上がり普通に使えます。タスクマネージャーのプロセス、通知領域のOutlookのアイコンは依然存在したままです。以上の様な、内容で少しは原因解明の参考になりますでしょうか?何か、Vistaのセキュリティー関係が関与しているようにも思いますしOutlook自体のバグのような気もしてきました…もうひとつ気が付いた事が在りますので報告しておきます。Outlook本体から起動したときは一瞬ですがOffice2003のロゴが表示されます。しかし、ガジェットから立ち上がる際はOffice2003のロゴは表示されません。何か、関係在るのでしょうか??では、色々とご迷惑お掛けしていますが何か解ればご連絡よろしくお願いいたします。長文すいませんでした。

  16. To ken 810 さんおそらく Outlook 2003 が正常に終了しないことが原因とは思われますが、なにぶん私のところでは現象が発生しないので、その原因がちょっとわかりません。ウィルススキャンソフトウェアなどの影響かもしれませんが、それらを使わないというわけにもいかないでしょう。また、起動時に送受信をする設定になっているのであれば、単にガジェットから起動したときに送受信が開始され、それが終了する前にウィンドウを閉じているのが原因かもしれません。ガジェットからウィンドウを開いてそれを閉じた後、通知領域の Outlook アイコンはずっと表示され続けるのでしょうか? 数分待っているとアイコンが消えるということはありませんか?もし、時間の経過でアイコンが消えるなら、単に終了処理に時間がかかっていることが原因であり、Outlook の不具合などではありません。その場合は、アイコンが消えるまで待っていただくか、常に Outlook を起動し続けるしか対処方法はないでしょう。

  17. 私の修正でもMillefeuilleさんの修正の時でもいいのですが、そのエラーが出てる行って> Set fldCalendar = nsSession.GetDefaultFolder(9)ですか?

  18. Millefeuilleさんタロウさんお世話になります。また、あけましておめでとうございます。早速ですが、報告いたします。まず、Millefeuilleさんの言われています、>ガジェットからウィンドウを開いてそれを閉じた後、通知領域の Outlook アイコンはずっと表示され続けるのでしょうか? 数分待っているとアイコンが消>えるということはありませんか?>もし、時間の経過でアイコンが消えるなら、単に終了処理に時間がかかっていることが原因であり、Outlook の不具合などではありません。の件ですが、待ってみましたが一向に消えることはありませんでした。また、Outlookでの送受信というよりもメール機能は一切使っておりません。タロウさんの件ですが、ご指摘通り> Set fldCalendar = nsSession.GetDefaultFolder(9)の部分になります。何か思い当たる事が在りますでしょうか?

  19. あれから、しばらく問題ない日々を送っていましたが、7/4あたりから>For each apptItem in colApptsでエラーが出るようになり、カレンダー表示出来なくなりました。※エラーはIEで起動して見てます。メッセージ: オブジェクトがコレクションではありません。oCalendarでも同様に「オブジェクトがコレクションではありません。」というエラーです。ちょっとこれはお手上げですね…何やらかしたんだMS…;;

  20. 理由が分かりました。colAppts.Count がアテにならない値を返す場合があり、そのせいで>For each apptItem in colApptsのループでエラーになってる様です。> For each apptItem in colAppts> spStart = apptItem.Startを> Dim ItemIndex>> For ItemIndex = 1 To colAppts.Count> Set apptItem = colAppts.Item(ItemIndex)>> On Error Resume Next> spStart = apptItem.Start> If Err.Number <> 0 Then> Exit For> End If> On Error Goto 0と変更したところ問題が解決しました。本当は、Do While 文を使って、appItemが空になるまで回したかったのですが>Do While apptItem = Null>Do While apptItem = 0というようにNullや0と比較しても、空かどうかが判定できなかったので、上記のような強引なコードになってます。

  21. To タロウさんちょっと手をつけられていなかったのですが、自己解決されたのですね。For Each がうまくいかない点については時間があるときに調査します。Do While で apptItem が空になるまで回すということであれば、Do While apptItem Is Nothingでいけるかもしれません。

  22. ついでに、ken 810さんの問題を解決しようと思い、以下のコードを入れてみました。やりたい事は、ウインドウが表示されている場合は終了・解放処理をしないという考えです。※Sub OpenDate(iYear, iMonth, iDay)内最終行 \’バックグラウンドで動いてるOutlookなら終了する If appOutlook.Visible = False Then appOutlook.Quit Set viewDate = Nothing Set oExp = Nothing Set fldCalendar = Nothing Set nsSession = Nothing Set appOutlook = Nothing End IfEnd Sub※Sub WriteCalendar( iYear, iMonth )内最終行 \’バックグラウンドで動いてるOutlookなら終了する If appOutlook.Visible = False Then appOutlook.Quit Set apptItem = Nothing Set colAppts = Nothing Set nsSession = Nothing Set appOutlook = Nothing End IfEnd Subしかし、以下のエラーでウインドウの表示・非表示が判定できませんでした。メッセージ: オブジェクトでサポートされていないプロパティまたはメソッドです。: \’appOutlook.Visible\’ライン: 273文字: 5コード: 0URI: file:///D:/kuribayasi/proj/outlookcal/outlookcal.gadget/outlookcal.htmlさて困った…何か良い案ありますでしょうか?

  23. Outlook の Application オブジェクトには Word や Excel のように Visible というプロパティはありません。ウィンドウが一つでも表示されているかどうかを確認するには、以下のようにするとよいでしょう。If appOutlook.ActiveWindow Is Nothing ThenActiveWindow とは 現在表示されている Outlook のウィンドウのことで、ウィンドウが一切表示されていなければ Nothing となります。ただ、この方法でうまくいくかどうかはちょっと疑問です。ウィンドウが表示されていないのに終了しないのであれば、別のアプリケーションから参照されているという状況が考えられます。このような場合、Outlook 2007 SP2 以降でない限り、たとえ Quit メソッドを実行しても Outlook のプロセスは終了しません。

  24. >ただ、この方法でうまくいくかどうかはちょっと疑問です。ですねぇ、単なる思い付きなので、実際のところはken 810さんに試してもらうしかないでしょう。※Sub OpenDate(iYear, iMonth, iDay)の下部を変更 Set viewDate = Nothing Set oExp = Nothing Set fldCalendar = Nothing Set nsSession = Nothing Set appOutlook = NothingEnd Sub↓ \’バックグラウンドで動いてるOutlookなら終了・解放する If appOutlook.ActiveWindow Is Nothing Then appOutlook.Quit Set viewDate = Nothing Set oExp = Nothing Set fldCalendar = Nothing Set nsSession = Nothing Set appOutlook = Nothing End IfEnd Sub※Sub WriteCalendar( iYear, iMonth )の下部を変更 Set apptItem = Nothing Set colAppts = Nothing Set nsSession = Nothing Set appOutlook = NothingEnd Sub↓ \’バックグラウンドで動いてるOutlookなら終了・解放する If appOutlook.ActiveWindow Is Nothing Then appOutlook.Quit Set apptItem = Nothing Set colAppts = Nothing Set nsSession = Nothing Set appOutlook = Nothing End IfEnd Sub

  25. けっこうコードの内容変わりまくってるので、今私の手元にある内容のものを、仮公開してもよろしいでしょうか?もちろん、ここが出元である事を書いて公開するつもりです。

  26. すみません、報告遅れました。以下の場所に置きました■Windows Sidebar – DoldoWorkzhttp://gyahahaha.s51.coreserver.jp/DoldoWorkz/?Windows%20Sidebar#OutlookCalender

  27. 使っているといっぱいバグを見つけてしまったので、バージョンアップを行いました。・月の初日(1日)の0:00~9:00の表示がされないバグ修正・終日 設定されている物が表示されないバグ修正・開始時間・終了時間の表示■Windows Sidebar – DoldoWorkzhttp://gyahahaha.s51.coreserver.jp/DoldoWorkz/?Windows%20Sidebar#OutlookCalender

  28. To タロウさん月初の 0:00 から 9:00 が表示されないのは、Restrict で日付のみの指定を行っているためだったみたいです。早速修正しました。また、終日の予定が表示されないのは、おそらくその予定の公開方法が [空き時間] または [仮の予定] になっているためでしょう。これらは意図的に表示しないようにしています。

  29. ご指摘ありがとうございます。>おそらくその予定の公開方法が [空き時間] または [仮の予定] になっているためでしょう。これらは意図的に表示しないようにしています。確かに[空き時間] または [仮の予定] になってました。 表示しないのはそういう事だったのですね。以上の指摘を元に、バージョンアップを行いました。・終日の判定が間違っていたので修正・公開方法が「空き時間」「仮の予定」になっている場合は下線で表示するように修正・背景のデザインを変更■Windows Sidebar – DoldoWorkzhttp://gyahahaha.s51.coreserver.jp/DoldoWorkz/?Windows%20Sidebar#OutlookCalender

  30. だいたい安定してきたので、そろそろ以下のマイクロソフト公式のページで公開しようと思うのですが、問題ありませんでしょうか?■サイドバー ガジェットhttp://vista.gallery.microsoft.com/vista/SideBar.aspx?mkt=ja-jp説明文の構成としては・元コードはMillefeuilleさんが作成した・公開した物は、そのコードにmoondoldoが修正を加えた・この「改造済みのコード」に対しての質問はmoondoldoへ ※質問が間違ってMillefeuilleさんに行くような迷惑をかけないため

  31. 公開しました。「カレンダー」か「Outlook」で検索すると出てくると思います。※MSNのアカウントの名前が適当に付けた物だったので、それも直しました。

  32. 窓の杜で紹介された様です。■窓の杜 – 【REVIEW】Outlookと連動するカレンダーガジェット「Outlook Calendar」http://www.forest.impress.co.jp/docs/review/20091105_326323.html

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中