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)に作業内容とか書いておけばこのメールに作業内容が入ります．

========

以上，

本文の番号のところには次のような情報を書いたり，マクロによって書かれています．

1. 今日の作業を優先順位を決めて自分で書くか2の所からコピーしてくる
2. オープン状態のタスクの一覧Tracから取り込んでいればそれも表示される．通常は＊が付いているものが本日の作業．！が付いているものは期日を過ぎている
3. 今後一カ月の予定が表示されます
4. このメールを前回送信した時間から今までの間に完了したものを表示
5. 上のものの中で仕事の本文に何か書いてあるものはそれを表示する．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 Function

Sub 今日の予定()
    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.Items

    mailbody = "各位" & vbCrLf & vbCrLf & "1.本日の作業予定" & vbCrLf & vbCrLf & _
    "2. オープンの仕事" & vbCrLf

    For 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 & vbCrLf

    mailbody = 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

昨日やったことはどうするかですが，いろいろやり方があるところなので，まだ実装してません．