仕事のこと

　最近、YahooやGoogleなどでオンラインカレンダーが使えるようになってきたが、会社では、グループウエアとしてLotus Notesを使ってスケジュールを管理しているため、あまり利用価値がないというのが実感であった。
　グループウエアは、多くのスケジュール管理が必要とする我々ビジネスマンにとっては、大変強力なツールで、会社内でのmeetingの設定にはなくてはならないものになっている。しかし、一旦、会社から出るとスケジュールを確認することができないのが難点であった。

　最近、「plaxo3.0」というソフトが出て、OUTLOOK,Yahoo（US）,Googleのカレンダーを同期させることが、なんと無料でできるようになった。これがあれば、外出先から、Googleのカレンダーに携帯で簡単にアクセスできる。
　
　だだ、、「plaxo3.0」は、OUTLOOKには対応しているのだが、会社で使っているLotus Notesには対応していないので、Lotus Notesのカレンダー情報をOUTLOOKへ移送してやることが必要である。
　今までも、LotusNotesからOutlookへのカレンダー情報の移送はやっていたのだが、携帯でデータを見るには、移送した後に、携帯とパソコンとを線でつないで、MysyncBizでもって、もう一度データを送信しなければならず、結構面倒であった。、plaxoを使うと、線をつなぐ必要がないので、ワンクッション減らすことができる。

　
　なお、Lotus Notesのカレンダー情報をOUTLOOKへ移送は、ポン太の独り言に書かれてあるLotusScriptを使うことで、エージェントでもってボタン一つで転送することができる。

実際の作成手順は、次のようになる。（スクリプトはカレンダーデータを全件送るようにポン太さんのソフトを少し改造した。）
①エージェントを作成を選ぶ
イメージ 1

エージェントの名前を決める。
イメージ 3

スケジュールを設定する。
イメージ 4

②次にlotusscriptを選択する。
イメージ 2

③最後にInitializeの部分に以下のプログラムを貼り付ければいい。

Sub Initialize
On Error Goto ErrorThrower 
	
Const  olFolderCalendar = &h00000009
Const olAppointmentItem = 1
Dim i As Integer
Dim count As Integer
Dim ABMin As Long
Dim objOutlook
Dim objAppointment
Dim myNameSpace
Dim myFolder
Dim myItem
Dim NextMonth As New NotesDateTime( "Today" )
Call NextMonth.AdjustMonth( 1 )
	
Set objOutlook =  CreateObject("Outlook.Application")
Set myNameSpace = objOutlook.GetNameSpace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
For i=myFolder.Items.Count To 1 Step -1
Set myItem = myFolder.Items(i)
myItem.Delete
Next i
	
Dim session As New NotesSession 
Dim db As NotesDatabase 
Dim doc As NotesDocument 
Dim col As NotesDocumentCollection 
Dim startDate As NotesDateTime, endDate As NotesDateTime 
	
Set db = session.CurrentDatabase
Set col = db.UnprocessedDocuments 
Set doc = col.GetFirstDocument
count = col.Count 
	
For ii=1 To count
If doc.HasItem("CalendarDateTime") Then
i=0
Forall CDate In doc.GetItemValue("CalendarDateTime")
i=i+1
Set objAppointment =objOutlook.CreateItem(olAppointmentItem)
objAppointment.Start = CDate
If  (doc.EndDateTime(i-1)-CDate)>0  Then
objAppointment.Duration =(doc.EndDateTime(i-1)-CDate)*24*60
Else
objAppointment.Start =   doc.EndDateTime(i-1)
objAppointment.Duration =0
End If
If doc.HasItem("Subject") Then
objAppointment.Subject = doc.GetItemValue("Subject")(0)
Else
objAppointment.Subject = ""
End If
If doc.HasItem("Body")  Then
objAppointment.Body = doc.GetItemValue("Body")(0)
Else
objAppointment.Body = ""
End If
If doc.HasItem("Location") Then
objAppointment.Location =doc.GetItemValue("Location")(0)
Else
objAppointment.Location = ""
End If
If doc.HasItem("Alarms") And doc.HasItem("$AlarmOffset") Then
If (doc.GetItemValue("Alarms")(0)="1") Then
objAppointment.ReminderSet = True
ABMin =Clng(doc.GetItemValue("$AlarmOffset")(0))
objAppointment.ReminderMinutesBeforeStart =Abs(ABMin)
Else
objAppointment.ReminderSet = False
End If
Else
objAppointment.ReminderSet = False
End If
Call objAppointment.Save
End Forall
End If
Set doc = col.GetNextDocument(doc)
Next ii		
Exit Sub 	
errorThrower: 
　Error Err, Error & Chr(13) + "Module: " &_ 
　Cstr( Getthreadinfo(1) ) & ", Line: " & Cstr( Erl ) 
Exit Sub 
End Sub