OutlookからiCalへのデータを出力するスクリプト

2 Mar

ぼくは、自分の予定をOutlookで管理している。
でも、一番よく使うパソコンはiBookなので、できればiCal(MacOSXの予定表ソフト)で予定を見たい。きれいだし。

ってわけで、そのためのものを探したけど、世の中いろいろとソフトがあるわりに、うまく動くのが少ない・・・。

ので、バイト中のヒマな時間に作ってみました。Outlookのスクリプト。
Outlookの予定データ→vCalenderのコンバータ。ただし、出力文字コードはShift-JIS

Outlookが終了されるタイミングで、指定したファイルにiCalのデータを吐く。ただ、Outlookが吐くデータはShift-JISなのに、iCalはUTF-8でしか読めない。ので、そこは何らかの解決法が必要。
lv -Ou8 tsutomu.tmp > tsutomu.ics
とか。うちでは、Outlookからスクリプトで共有フォルダ(Linuxサーバ)上に吐き出して、そこでcronで数分おきにファイルを変換してサーバーにアップしてる。

うちでのデータの流れはこんな感じ
・予定は、基本的にPDAで入力
・家に戻ったら、無線でWindowsパソコンに予定が送信される
・Windowsパソコンは、Outlookが起動して予定の受信
・予定の受信が終わったらOutlookがファイルを共有フォルダに吐き出す
・サーバーが数分おきに共有フォルダの一時ファイルを文字コード変換して公開ファイルに反映させる
・iBookでiCalを起動したら数分おきに最新のデータにアップデート

めんどくさいようだけど、予定の入力以外は全部自動でやってくれるから、ちょっと便利っぽい「気が」する。

スクリプトの内容は以下の通り

‘最初の3行は書き換える必要あり
Const CAL_DESCRIPTION = “Outlookに保管されている自分の予定”
Const CAL_NAME = “自分の予定”
Const CAL_FILENAME = “c:¥temp¥ical¥tsutomu.tmp”
Option Explicit

Sub ExportiCal()
Dim olApp As Application
Dim myNamespace As NameSpace
Dim fsFolder As MAPIFolder
Dim olItem As AppointmentItem

Set olApp = ThisOutlookSession
Set myNamespace = olApp.GetNamespace(“MAPI”)
Set fsFolder = myNamespace.GetDefaultFolder(olFolderCalendar)

Open CAL_FILENAME For Output As #1

‘Output Header
Print #1, “BEGIN:VCALENDAR”
Print #1, “CALSCALE:GREGORIAN”
Print #1, “X-WR-TIMEZONE:Asia/Tokyo”
Print #1, “METHOD:PUBLISH”
Print #1, “PRODID:-//Tsutomu Ohkura//ExportiCalScript 1.0//EN”
Print #1, “X-WR-CALNAME:” & CAL_NAME
Print #1, “VERSION:2.0”
Print #1, “X-WR-CALDESC:” & CAL_DESCRIPTION
Print #1, “BEGIN:VTIMEZONE”
Print #1, “LAST-MODIFIED:20040301T224807Z”
Print #1, “TZID:Asia/Tokyo”
Print #1, “BEGIN:STANDARD”
Print #1, “DTSTART:19371231T150000”
Print #1, “TZOFFSETTO:+0900”
Print #1, “TZOFFSETFROM:+0000”
Print #1, “TZNAME:JST”
Print #1, “END:STANDARD”
Print #1, “END:VTIMEZONE”

For Each olItem In fsFolder.Items
With olItem
If .End >= Now() Then ‘まだ終わっていない予定のみ
Print #1, “BEGIN:VEVENT”
Print #1, “DTSTAMP:” & convtime(.CreationTime) & “Z”
Print #1, “DTSTART;TZID=Asia/Tokyo:” & convtime(.Start)
If Len(.Location) > 0 Then
Print #1, “SUMMARY:” & .Subject & “(” & .Location & “)”
Else
Print #1, “SUMMARY:” & .Subject
End If
If Len(.Body) > 0 Then Print #1, “DESCRIPTION:” & Replace(.Body, vbCrLf, “\n”)
Print #1, “UID:” & .EntryID
Print #1, “DTEND;TZID=Asia/Tokyo:” & convtime(.End)
Print #1, “LOCATION:” & .Location
Print #1, “END:VEVENT”
End If
End With
Next olItem

‘Output Footer
Print #1, “END:VCALENDAR”

Close #1
End Sub

Function convtime(t As String) As String
Dim temp As String
temp = Replace(t, “/”, “”)
If Len(t) = 19 Then
temp = Replace(temp, ” “, “T”)
Else
temp = Replace(temp, ” “, “T0”)
End If
temp = Replace(temp, “:”, “”)
convtime = temp
End Function

Private Sub Application_Quit()
ExportiCal
End Sub

Leave a Reply

Your email address will not be published.