Trac-Outlook連携を使った朝会の準備
Shibuya.trac 第8回勉強会で朝回はwikiに書くということを聞いた.そういえばうちも似たようなことやってるなぁって事でその元になったものを公開します.職場向けのものはだいぶ更新して使っていて,これはあまり試してないのでバグがあるかもしれません.このマクロは,前に公開したTrac-Outlook連携のマクロと組み合わせることで,outlookに取り込んだTracのチケットと,会議やその他の予定とかその他のちょっとした作業をまとめてメールの元を作るものです.
出力結果は
本文を抜き出すと
各位
1.本日の作業予定
2. オープンの仕事
・ Test1:#2 test1-1
! 10/04-10/08 Test1:#8 10/04-10/08 期限切れのチケット
※ 凡例: !=期間を過ぎている*=今日作業予定
3.今後(一ヶ月)のスケジュール
10/11(Mon) 体育の日
10/13(Wed) 10:00-12:00 打ち合わせ
10/14(Thu)-10/15(Fri) 出張
4. 完了した作業
4.1. TracPlugin:#6 09/27-10/15 outlook connectorを登録する
4.2. Test1:#9 10/08-10/11 完了したチケット
5. 完了した作業の詳細
5.1. TracPlugin:#6 09/27-10/15 outlook connectorを登録する
http://192.168.0.65/trac/TracPlugin/ticket/6
Do not edit this task item.
n. 自動で登録するVBSを作る
n. ゴミ削除
========
5.2. Test1:#9 10/08-10/11 完了したチケット
http://192.168.1.4/trac/Test1/ticket/9
Do not edit this task item.
ここ(description)に作業内容とか書いておけばこのメールに作業内容が入ります.
========
以上,
本文の番号のところには次のような情報を書いたり,マクロによって書かれています.
- 今日の作業を優先順位を決めて自分で書くか2の所からコピーしてくる
- オープン状態のタスクの一覧Tracから取り込んでいればそれも表示される.通常は*が付いているものが本日の作業.!が付いているものは期日を過ぎている
- 今後一カ月の予定が表示されます
- このメールを前回送信した時間から今までの間に完了したものを表示
- 上のものの中で仕事の本文に何か書いてあるものはそれを表示する.Tracのチケットなら説明のところ
次はソースです.いつものようにどこかの標準モジュールに張り付けて,適当にツールバーのボタンに”今日の予定”を結び付けてください.
Function 予定の表示文字列を作成(app As AppointmentItem) As String
予定の表示文字列を作成 = month(app.Start) & "/" & Day(app.Start) & " " & Hour(app.Start) & ":" & Minute(app.Start)
If app.AllDayEvent Then
If app.End - app.Start > 1# Then
予定の表示文字列を作成 = Format(app.Start, "MM/DD(ddd)-") & Format(app.End - 1# / 24 / 3600, "MM/DD(ddd) ") & app.Subject
Else
予定の表示文字列を作成 = Format(app.Start, "MM/DD(ddd) ") & app.Subject
End If
Else
If app.End - app.Start > 1# Then
予定の表示文字列を作成 = Format(app.Start, "MM/DD(ddd)-") & Format(app.End, "MM/DD ") & app.Subject
Else
予定の表示文字列を作成 = Format(app.Start, "MM/DD(ddd) hh:mm-") & Format(app.End, "hh:mm ") & app.Subject
End If
End If
If app.Location <> "" Then
予定の表示文字列を作成 = 予定の表示文字列を作成 & "(" & app.Location & ")"
End If
End FunctionSub 今日の予定()
Dim mailbody As String
Dim tItem As TaskItem
Const mailSubject As String = "【連絡】本日の作業予定"
Set objNamespace = Application.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderTasks)
Set colTasks = objFolder.Itemsmailbody = "各位" & vbCrLf & vbCrLf & "1.本日の作業予定" & vbCrLf & vbCrLf & _
"2. オープンの仕事" & vbCrLfFor Each objTask In colTasks
Set tItem = objTask
'If objTask.PercentComplete < 100 And InStr(1, objTask.Subject, "????:#") <> 1 Then
If objTask.PercentComplete < 100 Then
If tItem.StartDate < Now() Then '開始日が今日より前
If tItem.DueDate < Now() + 1 Then '期間切れかどうか
mailbody = mailbody + "! "
Else
mailbody = mailbody + "* "
End If
Else
mailbody = mailbody + "・ "
End If
If tItem.StartDate = #1/1/4501# Then '期間が設定されているか
mailbody = mailbody + " "
Else
mailbody = mailbody + " " + Format(tItem.StartDate, "MM/DD-") + Format(tItem.DueDate, "MM/DD ")
End If
mailbody = mailbody + objTask.Subject & vbCrLf
End If
Next
mailbody = mailbody + "※ 凡例: !=期間を過ぎている *=今日作業予定" & vbCrLf
Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
Dim colApps As Items
Set colApps = objFolder.Items
mailbody = mailbody + vbCrLf & "3.今後(一ヶ月)のスケジュール" & vbCrLf
Dim app As AppointmentItem
colApps.sort ("Start")
For Each objApp In colApps
Set app = objApp
If (app.Start > Int(Now()) And app.Start < Int(Now()) + 31) _
Or (app.End > Int(Now()) And app.End < Int(Now()) + 31) Then
mailbody = mailbody + 予定の表示文字列を作成(app) & vbCrLf
End If 'Exit do入れたほうがいいかもしれないがそのまま
Next
Set myFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
Set colSentItems = myFolder.Items
Debug.Print colSentItems.Count
colSentItems.sort "SentOn"
' 前に送ったメールを検索し,prevDateにその時刻を設定する.
' 送信済みのアイテムを検索しますので,仕分けしている場合は修正してください.
Dim prevDate As Date
prevDate = Now() - 30 '見つからなかったら30日前にしておく
For Num = colSentItems.Count To 1 Step -1
Set item1 = colSentItems(Num)
If item1.Subject = mailSubject Then
prevDate = item1.SentOn
Exit For
End If
Next
Debug.Print Format(prevDate, "YYYY/MM/DD-") & Format(Now(), "YYYY/MM/DD")
mailbody = mailbody + vbCrLf & "4. 完了した作業" & vbCrLf
closedTasks = ""
closedDescription = ""
Dim no As Integer '番号は一致させたほうがいいと思うので一つの変数にする
no = 1
For Each objTask In colTasks
If objTask.PercentComplete = 100 And prevDate <= objTask.DateCompleted And objTask.DateCompleted < Now() Then
closedTasks = closedTasks + "4." & no & ". " & objTask.Subject & vbCrLf
If objTask.body <> "" Then
closedDescription = closedDescription + "5." & no & ". " & objTask.Subject & vbCrLf
closedDescription = closedDescription + objTask.body & vbCrLf & vbCrLf
closedDescription = closedDescription + "========" & vbCrLf
End If
no = no + 1
End If
Next
mailbody = mailbody + closedTasks & vbCrLf & vbCrLf
mailbody = mailbody + vbCrLf & "5. 完了した作業の詳細" & vbCrLf
mailbody = mailbody + closedDescription & vbCrLfmailbody = mailbody + vbCrLf & "以上," & vbCrLf
mailbody = mailbody + vbCrLf & "" & vbCrLf ' 自分の名前を書く
Dim objMail As MailItem
Set objMail = Application.CreateItem(olMailItem) 'olMailItem=0
objMail.To = Application.Session.CurrentUser.Address ' 送信したいアドレスに変更してください
objMail.Subject = mailSubject
objMail.body = mailbody
objMail.Display
End Sub
昨日やったことはどうするかですが,いろいろやり方があるところなので,まだ実装してません.
| 固定リンク
「Trac」カテゴリの記事
- Dockerでkanon(Trac)を動かしてみた2 - イメージの作成(2017.08.27)
- Dockerでkanon(Trac)を動かしてみた(2017.08.27)
- TracLightningにコバンザメしてKanonと同様にPluginをインストールする(2014.04.13)
- kanonをTrac1.0.1+MySQL対応に変更してみた(2013.11.24)
- kanonをTrac1.0.1対応に変更してみた(2013.11.11)
「VBA」カテゴリの記事
- メールで受け取ったファイルをSVNに登録する(2012.01.22)
- VBAでXMLRPCを汎用的に修正してTrac連携をそれに合わせて修正した(2011.10.24)
- Excelの(名前の管理のところの)名前の範囲の編集と,名前の範囲の値から複数選択するフォームとマクロ(2011.06.12)
- 状態遷移図からTracのワークフローを作るマクロにTracの設定の取り込み機能追加(2011.02.28)
- tracのワークフローをExcelの図で作った状態遷移図から作ってみる(2011.02.06)
「MS-Outlook」カテゴリの記事
- メールで受け取ったファイルをSVNに登録する(2012.01.22)
- Trac-Outlook連携を使った朝会の準備(2010.10.11)
- 取り込んだTracのチケットをWebページを開くコンテキストメニューを追加する(2010.02.15)
- Outlookへマクロを追加する方法とツールバーの編集(2010.02.13)
- TracのチケットをOutlookに取り込んで表示する.(2010.02.12)
この記事へのコメントは終了しました。
コメント