notesカレンダーとgoogleカレンダーとの同期
|
最近、YahooやGoogleなどでオンラインカレンダーが使えるようになってきたが、会社では、グループウエアとしてLotus Notesを使ってスケジュールを管理しているため、あまり利用価値がないというのが実感であった。 グループウエアは、多くのスケジュール管理が必要とする我々ビジネスマンにとっては、大変強力なツールで、会社内でのmeetingの設定にはなくてはならないものになっている。しかし、一旦、会社から出るとスケジュールを確認することができないのが難点であった。 最近、「plaxo3.0」というソフトが出て、OUTLOOK,Yahoo（US）,Googleのカレンダーを同期させることが、なんと無料でできるようになった。これがあれば、外出先から、Googleのカレンダーに携帯で簡単にアクセスできる。 だだ、、「plaxo3.0」は、OUTLOOKには対応しているのだが、会社で使っているLotus Notesには対応していないので、Lotus Notesのカレンダー情報をOUTLOOKへ移送してやることが必要である。 今までも、LotusNotesからOutlookへのカレンダー情報の移送はやっていたのだが、携帯でデータを見るには、移送した後に、携帯とパソコンとを線でつないで、MysyncBizでもって、もう一度データを送信しなければならず、結構面倒であった。、plaxoを使うと、線をつなぐ必要がないので、ワンクッション減らすことができる。 実際の作成手順は、次のようになる。（スクリプトはカレンダーデータを全件送るようにポン太さんのソフトを少し改造した。） �．─璽献Д鵐箸鮑鄒�を選ぶ エージェントの名前を決める。 スケジュールを設定する。 �⊆，�lotusscriptを選択する。 ��最後に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
|
「仕事のこと」書庫の記事一覧
-
2009/2/22(日) 午後 10:00
-
2009/2/22(日) 午前 0:40
-
2008/3/25(火) 午後 11:00
-
2008/2/7(木) 午後 10:09
-
2007/10/25(木) 午前 1:00
-
2007/3/23(金) 午前 0:31
エラーがでちゃうんですけど。 ど素人なのでわかんないです。（悲）
2010/2/7(日) 午後 9:42 [ 月光仮面 ]