自転車blog[lumia on the Saddle]スマートフォン,GPS,デジカメ,をフル活用したロードバイクの走行記録 

スポンサーサイト

   ↑  --/--/-- (--)  カテゴリー: スポンサー広告
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

(記事編集) http://cannondalem.blog101.fc2.com/?overture" target="_new

--/--/-- | Comment (-) | HOME | ↑ ページ先頭へ ↑ |

jorte(ジョルテ)とoutlookのオフライン同期 改良版

   ↑  2013/05/18 (土)  カテゴリー: スマートフォン

screenshot_2012-12-11_0025_modify

ひさしぶりにマニアックなスマートフォンネタ。会社でメール、スケジュール管理にoutlookを使っている(使わされている)。しかし、このoutlookがやっかいで、androidとの同期が非常に面倒。今までは同じmicrosoft製windows mobileだったので、usbで接続すれば、メールも、スケジュールも簡単に同期していた。このoutlookとの同期ができないと、「スマートフォン」とは認めない。

普通はgoogle calender syncを使って、outlookのデータをgoogle calenderと同期、そこからandroidに取り込むのだが、会社的にデータを社外のサーバに置くことに難色を示している。肝っ玉の小さい会社だ、、、

 

というわけで、google介さずに、usbの有線接続でのスケジュールの同期をやってみた。て、成功したのがこの画像。詳細はボカシ入れさせていただいていますが、outlookの内容がすべてandroidのカレンダーソフト「ジョルテ」に入力されています。

途中、色々苦労したので、忘れないようにメモ


 

blog

「ジョルテ,outlookの同期」ぐぐってみると、すぐに見つかる。やはりみんなおなじような状況のようです。みつかったのはフリーソフト等ではなく、outlook vba(?) が公開されています。一から作るのは難航しそうだが、改造程度ならなんとかなりそう。

http://opabin.sblo.jp/article/54734060.html

というわけで、ありがたく参考にさせていただきます。

 

outlook__input画面

公開されているコードを気合いで入力(ただのコピペですが、、)。しかし、ファイルがうまく出力されない。

エラーが発生するわけではないのだが、、、

outlook_参照設定

動作を追ってみると、utf-8でテキストを出力するADODBとやらが動いていない。

さらにぐぐってみると、「参照設定」が必要のとのこと。というわけで早速上記のとおり追加。画像の一番下の「Microsoft Active X Data Object」です。

 

これで、無事に成功。

使い方は、マクロの公開元を参照してください。

 

ついでに、無事に動いたので、一部自分仕様に改良。内容は以下の通り。

  • スケジュールの出力を 今月と来月だけ → 先月~3か月先まで
  • 予定のタイトル、時間だけを出力 → 予定の中身も出力

やっぱりソースコードがあると、かゆい所に手が届いていいかんじです。

 

というわけで、私も折角なので公開しておきます。

AS YOUR OWN RISK !!で。

 

 

   1:  '################################################################
   2:  'outlook to JORTE(android), CSV output macro
   3:  '################################################################
   4:   
   5:  Public Sub ExportMyCaldndar()
   6:  Const MY_CSV_FILE_NAME = "schedule_data.csv" '## JORTEのデフォルトファイル名
   7:  Dim fldCalendar  As Object 'As Folder
   8:  Set fldCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
   9:  ExportThisMonth fldCalendar, MY_CSV_FILE_NAME
  10:   
  11:  End Sub
  12:   
  13:  ' 共通ルーチン
  14:  Public Sub ExportThisMonth(fldCalendar, strCsvName As String)
  15:  '#### const section
  16:  Const JORTE_ENV = "JORTEDIR" '#### 環境変数 %JORTEDIR% 配下に書き込む
  17:   
  18:  '#### Dim section
  19:  Dim strFileName As String
  20:  Dim strStart As String
  21:  Dim strEnd As String
  22:  Dim dtExport As Date
  23:  Dim objFSO 'As FileSystemObject
  24:  Dim stmCSVFile 'As TextStream
  25:  Dim colAppts As Items
  26:  Dim objAppt As AppointmentItem
  27:  Dim strLine As String
  28:  Dim envString As String '環境変数
  29:  Dim FSO As Object 'フォルダの存在有無
  30:  '
  31:  '#### 出力ファイル名の設定
  32:  '# 1) 環境変数 JORTEDIR があり && 書き込み可能
  33:  '# 2) なければ、環境変数 TEMP があり && 書き込み可能
  34:  '# 3) それもなければ、C:\ に書き込む
  35:  envString = Environ(JORTE_ENV)
  36:  Set FSO = CreateObject("Scripting.FileSystemObject")
  37:  On Error GoTo EnvErr1
  38:  If envString = "" Or Not FSO.FolderExists(envString) Then
  39:  On Error GoTo EnvErr2
  40:  envString = Environ("TEMP")
  41:  If envString = "" Or Not FSO.FolderExists(envString) Then
  42:  On Error GoTo 0
  43:  envString = "c:"
  44:  End If
  45:  End If
  46:  GoTo EnvBrk
  47:  EnvErr1:
  48:  Resume Next
  49:  EnvErr2:
  50:  Resume Next
  51:  EnvBrk:
  52:  strFileName = envString & "\" & strCsvName
  53:   
  54:  MsgBox (strFileName)
  55:   
  56:   
  57:  dtExport = Now
  58:  strStart = Year(Now) & "/" & Month(Now) - 1 & "/1 00:00"
  59:  strEnd = DateAdd("m", 1, CDate(strStart)) & " 00:00"
  60:  strEnd = DateAdd("m", 2, CDate(strStart)) & " 00:00"
  61:  strEnd = DateAdd("m", 3, CDate(strStart)) & " 00:00"
  62:  strEnd = DateAdd("m", 4, CDate(strStart)) & " 00:00"
  63:   
  64:   
  65:  '
  66:  Set objFSO = CreateObject("Scripting.FileSystemObject")
  67:  Set stmCSVFile = objFSO.CreateTextFile(strFileName, True)
  68:   
  69:  ' ADODB.Streamのモード
  70:  Dim adTypeBinary: adTypeBinary = 1
  71:  Dim adTypeText: adTypeText = 2
  72:  Dim adSaveCreateOverWrite: adSaveCreateOverWrite = 2
  73:   
  74:  ' ADODB.Streamを作成
  75:  Dim pre: Set pre = CreateObject("ADODB.Stream")
  76:  ' 最初はテキストモードでUTF-8で書き込む
  77:  pre.Type = adTypeText
  78:  pre.Charset = "UTF-8"
  79:  pre.Open
  80:   
  81:  ' CSV ファイルのヘッダです。出力するフィールドを増減する場合はこちらも変更してください。
  82:  stmCSVFile.WriteLine "dtstart,dtend,time_start,time_end,title,timeslot,holiday,event_timezone,calendar_rule,rrule,on_holiday_rule,content,location,importance,completion,char_color,icon_id,reminders" & vbCrLf
  83:  pre.WriteText ("dtstart,dtend,time_start,time_end,title,timeslot,holiday,event_timezone,calendar_rule,rrule,on_holiday_rule,content,location,importance,completion,char_color,icon_id,reminders" & vbCrLf)
  84:   
  85:  '
  86:   
  87:  Set colAppts = fldCalendar.Items
  88:  colAppts.Sort "[Start]"
  89:  colAppts.IncludeRecurrences = True
  90:  Set objAppt = colAppts.Find("[Start] < """ & strEnd & """ AND [End] >= """ & strStart & """")
  91:  While Not objAppt Is Nothing
  92:   strLine = """" & objAppt.Subject & _
  93:   """,""" & objAppt.Location & _
  94:   """,""" & FormatDateTime(objAppt.Start, vbShortDate) & _
  95:   """,""" & FormatDateTime(objAppt.Start, vbShortTime) & _
  96:   """,""" & FormatDateTime(objAppt.End, vbShortDate) & _
  97:   """,""" & FormatDateTime(objAppt.End, vbShortTime) & _
  98:   """,""" & objAppt.Categories & _
  99:   """,""" & objAppt.Organizer & _
 100:   """,""" & objAppt.RequiredAttendees & _
 101:   """,""" & objAppt.OptionalAttendees & _
 102:   """"
 103:   
 104:  'BusyStatus (100:0=cancel/101:1=仮/102:2=OK/103:3=外出)
 105:  If CInt(objAppt.BusyStatus) <> 1000 Then
 106:  ' (cancel予定出なければ書き込み)
 107:   
 108:  'strLine = FormatDateTime(objAppt.Start, vbShortDate) & _
 109:  '"," & FormatDateTime(objAppt.End, vbShortDate) & _
 110:  '"," & FormatDateTime(objAppt.Start, vbShortTime) & _
 111:  '"," & FormatDateTime(objAppt.End, vbShortTime) & _
 112:  '",""" & objAppt.Subject & _
 113:  '""",0,0,Asia/Tokyo,2,,0,,""" & objAppt.Location & _
 114:  '""",0,0,0,,10" & vbCrLf
 115:   
 116:   
 117:  strLine = FormatDateTime(objAppt.Start, vbShortDate) & _
 118:  "," & FormatDateTime(objAppt.End, vbShortDate) & _
 119:  "," & FormatDateTime(objAppt.Start, vbShortTime) & _
 120:  "," & FormatDateTime(objAppt.End, vbShortTime) & _
 121:  ",""" & objAppt.Subject & _
 122:  """,0,0,Asia/Tokyo,2,,0,""" & objAppt.Body & """,""" & objAppt.Location & _
 123:  """,0,0,0,,10" & vbCrLf
 124:   
 125:   
 126:   
 127:  stmCSVFile.WriteLine strLine
 128:  pre.WriteText (strLine)
 129:  '
 130:  End If
 131:  '
 132:  Set objAppt = colAppts.FindNext
 133:  Wend
 134:   
 135:  stmCSVFile.Close
 136:  ' ADO
 137:  ' バイナリモードにするためにPositionを一度0に戻す
 138:  ' Readするためにはバイナリタイプでないといけない
 139:  pre.Position = 0
 140:  pre.Type = adTypeBinary
 141:  ' Positionを3にしてから読み込むことで最初の3バイトをスキップする
 142:  ' つまりBOMをスキップします
 143:  pre.Position = 3
 144:  Dim bin: bin = pre.Read()
 145:  pre.Close
 146:   
 147:  ' 読み込んだバイナリデータをバイナリデータとしてファイルに出力する
 148:  ' ここは一般的な書き方なので説明を省略
 149:  Dim stm: Set stm = CreateObject("ADODB.Stream")
 150:  stm.Type = adTypeBinary
 151:  stm.Open
 152:  stm.Write (bin)
 153:  stm.SaveToFile strFileName, adSaveCreateOverWrite ' force overwrite
 154:  stm.Close
 155:  ' ADODB (UTF - 8): Close
 156:  End Sub
関連記事

(記事編集) http://cannondalem.blog101.fc2.com/blog-entry-641.html

2013/05/18 | Comment (6) | Trackback (0) | HOME | ↑ ページ先頭へ ↑ |

Comment


改行コード無しでソースを記載されているようですよ

#GalaxyならKIESで予定表の同期ができるのですが、HTCだとHTC Syncでの同期がイマイチでちょっと使えない

 |  2013/05/16 (木) 15:57 No.275


Re: タイトルなし

プレビューではちゃんと表示されてなかったので、気づきませんでした
ご指摘ありがとうございます。

しかし、やはり自動で同期しないと、イザというときに同期できてなくてイライラしますね、、

CannondaleM |  2013/05/18 (土) 20:24 No.277


outlookとのデータのやりとり

はじめまして。
 スマホでjorteを使い、職場の日程管理でoutlookを使っています。職場のセキュリティの関係で、クラウド同期が出来ないため、オフラインでの同期は大変役にたっています。
 先日jorteのバージョンアップをしてから、それまで出来ていた、outlookのデータをjorteに入力することが出来なくなりました。
 何か対応出来ることはないでしょうか。
スマホ:F-02E
ジョルテ 1.5.17
よろしくお願いします。

pxw11130 |  2013/07/20 (土) 13:59 No.282


Re: outlookとのデータのやりとり

しばらく同期していない間にデータ形式が変わったんでしょうか、、、
検討してみますので、しばしお待ちください

CannondaleM |  2013/07/21 (日) 23:23 No.283


先月のスケジュール出力について

こんばんは。先月から利用させていただいて、とても重宝しています。
ところで、1月にマクロを実行するとエラーになるようです。

If Month(Now) = 1 Then
strStart = Year(Now) - 1 & "/" & 12 & "/1 00:00"
Else
strStart = Year(Now) & "/" & Month(Now) - 1 & "/1 00:00"
End If
こんな感じに修正してみました。

puka |  2015/01/06 (火) 22:56 [ 編集 ] No.344


Re: 先月のスケジュール出力について

修正ありがとうございます。
しかし、だめだ、、、ソースコードみても、自分が手を加えたところがどこかもわからない、、
必要なモノができて、モチベーションがあがると、一気にプログラミングするのですが、基本趣味のプログラマなので忘れるのもあっというま、、、

私の環境がoutlookから他のグループウェア、さらにandroidからWindows Phoneに戻ったのでほぼJorteは使わなくなったので、忘れてしまいました、、、

こんな状態で申し訳ないですが、よろしければ、今後ともご活用下さい

CannondaleM |  2015/01/09 (金) 01:23 No.345

コメントを投稿する 記事: jorte(ジョルテ)とoutlookのオフライン同期 改良版

お気軽にコメントをぞうぞ。
非公開 (管理人のみ閲覧可能なコメント) にしたい場合には、ロック にチェックを入れてください。

  任意 : 後から修正や削除ができます。
 

Trackback

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。