前回に続き、タスクシュ－ト機能の表示改善。

その1. 一日の予測時間と実働時間の表示改善

その2. 実施中のタスクの予測時間と実働時間の表示改善

まだまだハックしたりないけれど、とりあえずこんなところでゴ－ルデンウィ－クの目標は達成。

VBAの使い方がなんとなくわかったよ。

Outlookでタスクシュ－トをする機能を実装した。

と、いっても実際にしたことは大したことではないのだけれど。

選択したタスクの予測時間の合計を現在時間に足して表示しただけ。

本当ならば、今日のタスクも自動的に検索できればいいけれど、

そこはまだスキルが足りない。手動選択が楽だ。

フォ－ム File:TaskChuteForm:

Private Sub UserForm_Initialize()
  Dim End_Time
  Dim End_Hour
  Dim End_Minute
  Dim TotalWork_Time As Long
  
  TotalWork_Time = GetSelectedTotalWorkTime()
  End_Time = DateAdd("n", TotalWork_Time, Time)
  End_Hour = Hour(End_Time)
  End_Minute = Minute(End_Time)
  
  TaskChuteForm.ListBox1.AddItem Hour(Time) & ":" & Minute(Time)
  TaskChuteForm.ListBox2.AddItem End_Hour & ":" & End_Minute
End Sub

TithOutlookSession:

Function GetSelectedTotalWorkTime()
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim TotalWork_Sum As Long
    Dim x As Integer
 
    TotalWork_Sum = 0
    
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection
    For x = 1 To myOlSel.Count
        TotalWork_Sum = TotalWork_Sum + myOlSel.Item(x).TotalWork
    Next x
    
    GetSelectedTotalWorkTime = TotalWork_Sum
End Function

以下の機能を新たに実装してみた。

• Outlookタスクの実働時間の記録
• Outlookタスクの予定表への出力

タスクの起動をイベントプロシージャで監視して、起動したら起動時間を記録

タスクの終了をイベントプロシージャで監視して、終了したら起動時間と現在時間との差分を実働時間に記録

それとともに、起動時間と現在時間を利用して予定表に予定を出力。

今は１つのタスクにした監視ができないので、ここは要改善！

File: ThisOutlookSection

Dim WithEvents myInspectors As Inspectors
Dim WithEvents myTaskItem As TaskItem
Private Sub Application_Startup()
  Set myInspectors = Outlook.Inspectors
End Sub
Private Sub myInspectors_NewInspector(ByVal Inspector As Inspector)
  If TypeName(Inspector.CurrentItem) = "TaskItem" Then
    Set myTaskItem = Inspector.CurrentItem
  End If
End Sub

'タスク起動
Private Sub myTaskItem_Open(Cancel As Boolean)
  '起動時間を記録
  Call TaskTrace_StartTimer
End Sub

'タスク終了
Private Sub myTaskItem_Close(Cancel As Boolean)
  ' 予定表にログを生成
  Call TaskLog_Create(myTaskItem.Subject)
  '実働時間を獲得
  myTaskItem.ActualWork = (myTaskItem.ActualWork + TaskTrace_GetActualWorkTime())
  Set myTaskItem = Nothing
End Sub

File: TaskTrace

'---------------------------------------------------------------------
'タスクの起動時間を実働時間に記録する
'---------------------------------------------------------------------
Option Explicit

Dim start_time

Public Sub TaskTrace_StartTimer()
  start_time = Now()
End Sub

Public Sub TaskTrace_StopTimer()
  start_time = 0
End Sub

Public Function TaskTrace_GetActualWorkTime()
  Dim current_actualwork_time
  TaskTrace_GetActualWorkTime = DateDiff("n", start_time, Now())
  start_time = 0
End Function

Public Function TaskTrace_GetStartTime()
  TaskTrace_GetStartTime = start_time
End Function

File: TaskLog

'---------------------------------------------------------------------
' 予定を生成
'---------------------------------------------------------------------
Public Sub TaskLog_Create(jobNAME As String)
  Dim fldCalendar As Folder
  Dim aITEM As AppointmentItem
  
  'フォルダ指定
  Set fldCalendar = Session.Folders("Outlook").Folders("予定表").Folders("TaskLog")
  Set aITEM = fldCalendar.Items.Add
  
  With aITEM
    .Subject = jobNAME
    .Body = "Samplebody"
    .Start = TaskTrace_GetStartTime()
    .End = Now
    .Save
  End With
End Sub

参考リンクはココ

http://outlooklab.wordpress.com/category/outlook-vba-%E3%83%9E%E3%82%AF%E3%83%AD/

VB Lite Unitの記法がなんとなくわかってきたのでメモ 〆(._.)

この定形ソ－スをクラスモジュールで作成してところどころ修正。

File:SampleTest

'おまじない
Option Explicit
Implements ITestCase

Private Function ITestCase_TestCaseInstance() As ITestCase
  Dim objResult As New TaskTraceTest
  ' Test for cut/paste error - programmer forgot to change type of objResult.
  'Debug.Assert TypeName(objResult) = TypeName(Me)
  Set ITestCase_TestCaseInstance = objResult
End Function

'テストスイ－ト？ここはまだ未調査
Private Property Get ITestCase_Suite() As Variant
  ' Do nothing here
  ' Only run tests within RunTest.
End Property

'実験用にtemp変数宣言。ITestCase_RunTest内で宣言したら失敗した。
Private temp As Integer

'ここからテスト関数
Private Sub ITestCase_RunTest( _
  ByVal TestNum As Long, _
  TestName As String, _
  ExpectErrNum As Long, _
  EndOfTests As Boolean _
)
  Dim objTestNum As New TestNumGenerator

  Select Case TestNum
    Case tstcTestActionSetup
      'ここにSetupで実行したいことを書く

    Case tstcTestActionTeardown
      'ここにTearDownで実行したいことを書く
    
    'ここからテスト  
    Case objTestNum.NextNumber
       'AssertEqualがアサ－ト関数 第三引数でテストの名前を書く
       AssertEqual 1, temp, "first"

    Case objTestNum.NextNumber
       'Test2....

    Case objTestNum.NextNumber
       'Test3....

        'Case 文を追加してどんどんテストを書く

    Case Else
      EndOfTests = True

  End Select

End Sub

実行はイミディエイトウィンドウで以下を実行

Runtests New SampleTest

ショ－トカットキ－の Ctrl + G と F7 を利用してテストを小さく回す。

う－む快感。(´∀｀)

ExcelやWordはオブジェクトにたいして直接イベントプロシ－ジャを作ることができるけれど、

Outlookはそれができない。

http://msdn.microsoft.com/ja-jp/library/cc344580.aspx

Outlook 起動時にApplicationオブジェクトの初期化処理で 一細工必要。

参考リンクはココ

http://www.pcreview.co.uk/forums/event-changing-task-status-t3695718.html

ThisOutlookSession code windowに記述する必要がある。

Dim WithEvents myInspectors As Inspectors
Dim WithEvents myTaskItem As TaskItem
Private Sub Application_Startup()
  Set myInspectors = Outlook.Inspectors
End Sub

Private Sub myInspectors_NewInspector(ByVal Inspector As Inspector)
  If TypeName(Inspector.CurrentItem) = "TaskItem" Then
    Set myTaskItem = Inspector.CurrentItem
  End If
End Sub

'タスクをオ－プンしたときの処理
Private Sub myTaskItem_Open(Cancel As Boolean)
  MsgBox "Task Open!"
End Sub
'タスクをクロ－ズしたときの処理
Private Sub myTaskItem_Close(Cancel As Boolean)
  Set myTaskItem = Nothing
End Sub

Outlookで複数タスクを登録するマクロを作ったので、ソ－スを公開。

たとえは、マインドマップでタスクを洗い出したあと、

登録するためには今までは１つずつ登録が必要だったが、

これで一括登録可能だ。

Module1

Dim InputText As String

'与えられたリストからタスクを複数生成するマクロ
Sub CreateMultiTasks()
Dim max As Integer
Dim Subjects() As String

'入力フォ－ム表示し、複数タスク取得
UserForm1.Show

Subjects() = Split(InputText, vbCr) '複数タスクを分割
max = UBound(Subjects()) 'タスク数を取得

For i = 0 To (max - 1)
  Call CreateTask(Subjects(i)) 'タスク生成
Next i

End Sub

'入力テキスト取得
Function GetTextBox(ByVal text As String)
InputText = text
End Function

Module2

Sub CreateTask(jobNAME As String)
 'タスクオブジェクト生成 (olTaskItem=3 TaskItemオブジェクト)
  Dim oITEM As TaskItem
  Set oITEM = Application.CreateItem(olTaskItem)
    
  With oITEM
    '.Display  '画面表示

    'データセット
    .Subject = jobNAME  '件名
    .Categories = "!Inbox" '分類項目に!Inboxを追加
    
    'タスクを登録
    .Close 0  'olSaveで閉じるときに保存(セーブして終了)
  End With
End Sub

UserForm1

Private Sub OK_Click()
Call GetTextBox(TextBox1.text)
Unload Me
End Sub
Private Sub Cancel_Click()
End
End Sub

Outlookのタスクをショ－トカットから生成するVBScriptを作った。

参考にしたのはこのペ－ジ

http://www.ken3.org/cgi-bin/group/vba_outlook_Task.asp

上記リンクのスクリプトを少しカスタマイズした。

具体的には

• 分類項目にInboxを割り当てる機能を追加
• ﾂꀀ開始日や期限の割り当てを解除
• タスク件名を入力するメッセ－ジで[ GTD Prosess Start!!]と表示

さらにvbsのショ－トカットにショ－トカットキ－を割り当てて(Ctrl＋Alt＋Tとか）

どこからでも起動できるようにした。

ショ－トカットキ－を起動するにはショ－トカットをデスクトップかスタ－トメニュ－に置かなければいけないらしい。

http://support.microsoft.com/kb/134552/ja

デスクトップに置くのは自分の美学が許さないので？？

[ スタ－トメニュ－] > [すべてのプログラム]を右クリックして、その先の[プログラム]の下にショ－トカットをセット。

これで頭に浮かんだアイデアを即座に Outlookという GTD システムへキャブチャ－できる。