取り込んだTracのチケットをWebページを開くコンテキストメニューを追加する

勢いのあるうちに書いていかないとまた更新しなくなっちゃいそうなので，Outlookのタスクのなかで，内容の先頭行に"HTTP://"があった場合に，そのページを開くコンテキストメニューを追加する方法について書きます．CRがあることを前提としているので内容が二行以上ないとだめです．これがあれば，チケットを更新するときも少し楽になるかなぁ

まずは，ThisOutlookSessionにコンテキストメニューが表示されるときに呼ばれる，Application_ItemContextMenuDisplayを追加します．

Private Sub Application_ItemContextMenuDisplay(ByVal CommandBar As Office.CommandBar, ByVal Selection As Selection)
    If Selection.Count = 1 And Selection.Item(1).Class = olTask Then
        Dim tItem As TaskItem
        Set tItem = Selection.Item(1)
        Debug.Print tItem.Subject
        If InStr(1, tItem.Body, "http://") = 1 Then
            Dim btn As CommandBarButton
            Set btn = CommandBar.Controls.Add(msoControlButton, Temporary:=True)
            btn.Caption = "リンクを開く"
            btn.OnAction = "リンクを開く"
        End If
    End If
End Sub

次にOnActionに設定している"リンクを開く"をどこかの標準モジュールに追加します．

Sub リンクを開く()
    Dim sel As Selection
    Set sel = Application.ActiveExplorer.Selection
    If sel.Item(1).Class = olTask Then
        Dim tItem As TaskItem
        Set tItem = sel.Item(1)
        Debug.Print tItem.Subject
        If InStr(1, tItem.Body, "http://") = 1 Then
            'http://officetanaka.net/excel/vba/tips/tips42.htm
            Dim WSH
            Set WSH = CreateObject("Wscript.Shell")
            WSH.Run Left(tItem.Body, InStr(7, tItem.Body, "" & vbCr)), 3
            Set WSH = Nothing
        End If
    End If
End Sub