Ｋ２さんの雑記

■ 一日雨

降っていない時間も多かったのだが、いつ大雨が来るかわからない状況。案の定、午後から大雨。

全然走りにいけないなー。

■ tDiaryが表示されなくなった

突然今日から。PStore関連のエラーが出る。ぐぐっても、似たようなエラーが出るトラブルは多いが、私のケースには当てはまらない。

試しにプラグインを全部切ったら正常に戻った。

原因は、disp_referrer.rbだった。これ以上深入りして調べていないので、根本的な原因は不明。

■ ココアピーナッツ

ばいもろぞふ。これはうまい。

ウィスキーを飲むことをやめることができなので、買うのはやめた方がよいよ。

■ ドラッカー読書シリーズ

昨年来勉強し続ける中で、一度ドラッカーはぢゃんと読んでみたいなと思っていて、でも本多すぎるしどこから手をつければよいのかと。

で、以下の順で読むことにした。

1. ドラッカーわが軌跡
2. 経済人の終わり
3. 産業人の未来
4. 企業とは何か
5. ドラッカー３６５の金言
6. マネジメント　上下

忘れてしまったが、どこかのサイトに、この順で読むと良いと書いてあったので、とりあえず。

で、２冊目まで読了。

ドラッカー わが軌跡(P.F.ドラッカー)

ドラッカーわが軌跡。子供の頃から、多くの個性的な人と会う環境にあり、それらの人をつづった本。ドラッカーの経歴や人の見方を概観できる。

ドラッカー名著集9 「経済人」の終わり(P・F・ドラッカー)

「経済人」の終わり。いかにして虚無に陥る人が全体主義へ流れていくか、そのメカニズムを説き明かす、ドラッカーの処女作。書き始めたのは20代前半だと言うから、いかに奇才かがよくわかる。ブルジョア資本主義とマルクス社会主義の終焉から、ファシズム全体主義へ向かう必然をわかりやすく説明している。テーマから想像できる難しさとは無縁であり、一気に最後まで読める。

この後のシリーズが楽しみだ。

■ Outlook強制化

私の部署の一斉切り替えがあり、昨日からOutlookでのメール作業が強制化されました。

いや一種の業務テロだぜ、これは。

生産性が1/2くらいに落ちる。

後、どうも紙の本を読んでいるところから、PCで本を読むようになった初期の頃の感覚に近い。メール本文が頭に入ってこない。

まぁ慣れるしかないのです。

さて、ここにTaskPrizeでの作業をどう割り込ましていこうか。まずは、OutlookからTaskPrizeへメールを飛ばせるようにしたい。

■ OutlookからTaskPrizeへメールを飛ばすマクロ

ちょっとまだ作り込みが甘いけど、とりあえず動きました。

所要時間４時間くらいか。意外と簡単にできました。

TaskPrizeには、MBOX形式のテキストファイルを起動オプションで指定してやると取り込めるので、Outlookで選択されているメールを、MBOX形式でファイルに落として、TaskPrizeを起動するというマクロを書けばOK。

なのだが、ヘッダ付きのメールを得るのが一苦労。Outlook2007未満では、マクロではできなかったようなので、まぁできることに感謝したい。

取得したヘッダは、改行付きの連続文字列で取得できる。これをプロパティごとに分解しなければならない。

StringListクラスがVBAにあると簡単なのだが、どうもないらしい。仕方がないので、改行コードを検索することにした。まぁこれもなんとか動いているようだ。

ヘッダ付きのテキストに落とすだけのマクロも、なかなか例としては見つけられなかった。下記のマクロは、ちょっと改造すればその用途にも十分使えるし、ヘッダを表示するマクロなんてのもすぐにできるだろう。

   '===========================================================
   '  TaskPrizeへメールを送る
   '                               2015/7/16 by K2
   '===========================================================
   Public Sub TPZSendMail()
       Dim myOLobj As Selection, M As MailItem, PA As propertyAccessor
       Dim I As Integer
       Dim FileName As String
       I = 0
       'テンポラリファイルはとりあえず決め打ち
       FileName = "C:\TPZ.txt"
       Set myOLobj = Application.ActiveExplorer.Selection
       For Each M In myOLobj
           If I <> 0 Then
               '複数のメールが選択されている場合はピリオドだけの行を出力
               Open FileName For Append As #1
               Print #1, "."
               Close #1
           End If
           MailSaveForTPZ M, FileName, I
           I = I + 1
       Next

       '以下はTaskPrizeのインストールフォルダのパスに書き換える必要有り
       Shell "E:\Project\TaskPrize2\TskPrize.exe -ic:\TPZ.txt", vbNormalFocus
   End Sub

   '-----------------------------------------------------------
   '  メール一通をテンポラリファイルに出力
   '-----------------------------------------------------------
   Private Sub MailSaveForTPZ(oMail As MailItem, FileName As String, Mode As Integer)
       Dim Header As String
       Dim PropName As String
       Dim oPA As propertyAccessor
       Dim S As String
       'PR_TRANSPORT_MESSAGE_HEADERS
       PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
       'Obtain an instance of PropertyAccessor class
       Set oPA = oMail.propertyAccessor
       'Call GetProperty

       Header = oPA.GetProperty(PropName)

       If Mode = 0 Then
           Open FileName For Output As #1
       Else
           Open FileName For Append As #1
       End If
       Print #1, Header
       S = GetTPZMailPrescript(oMail, Header)
       Print #1, S
       Print #1, oMail.Body
       Close #1
   End Sub

   '-----------------------------------------------------------
   '  TPZへ送るメールの先頭部分の文字列を得る
   '-----------------------------------------------------------
   Private Function GetTPZMailPrescript(oMail As MailItem, sHeader As String) As String
       Dim S As String
       S = "------------------------------------------------------------" & vbCr & vbLf
       S = S & " | Date      : " & GetHeaderText(sHeader, "Date: ") & vbCr & vbLf
       S = S & " | From      : " & oMail.SenderName & vbCr & vbLf
       S = S & " | Subject   : " & oMail.Subject & vbCr & vbLf
       S = S & " | Message-ID: " & GetHeaderText(sHeader, "Message-ID: ") & vbCr & vbLf
       S = S & "------------------------------------------------------------"
       GetTPZMailPrescript = S
   End Function

   '-----------------------------------------------------------
   '  指定されたヘッダー文字列を得る
   '    複数行にわたるヘッダには対応していないので注意
   '-----------------------------------------------------------
   Private Function GetHeaderText(Header As String, Prop As String) As String
       Dim I As Variant, Length As Integer
       I = InStr(1, Header, Prop, vbTextCompare)
       If I > 0 Then
           I = I + Len(Prop)
           Length = InStr(I, Header, vbCrLf, vbTextCompare)
           If Length > 0 Then
             Length = Length - I
           Else
             Length = Len(Header) - I + 1
           End If
           GetHeaderText = Mid(Header, I, Length)
       Else
           GetHeaderText = ""
       End If
   End Function

しかし、やっぱりBASICはきらい。この文法はどうも私には合わない。

VBの関数で、()をつけるとエラーになるのとならないのは、どういう違いがあるのだろう。SubとFunctionの違いでもなさそう……

P.S.(2018/7/26) 最近、突然仕様が変わったのか、Outlookメールのヘッダで、Message-ID:の行が複数行仕様になってしまった。そのため、上記のGetHeaderTextではうまく動かなくなった。

GetHeaderTextの修正版を作成したので、記入しておきます。

   '-----------------------------------------------------------
   '  指定されたヘッダー文字列を得る
   '-----------------------------------------------------------
   Private Function GetHeaderText(Header As String, Prop As String) As String
       Dim I As Variant, Length As Integer
       Dim nextLineIndex As Integer
       I = InStr(1, Header, Prop, vbTextCompare)
       If I > 0 Then
           I = I + Len(Prop)
           Length = InStr(I, Header, vbCrLf, vbTextCompare)
           If Length > 0 Then
             nextLineIndex = Length + 2
             Length = Length - I
           Else
             nextLineIndex = 0
             Length = Len(Header) - I + 1
           End If
           GetHeaderText = LTrim(Mid(Header, I, Length)) 'ヘッダ直前のスペースは削除する
           ' 次の行から、行頭がホワイトスペースでない行まで、行を連結する
           Do While nextLineIndex > 0 And (Mid(Header, nextLineIndex, 1) = " " Or Mid(Header, nextLineIndex, 1) = vbTab)
               I = nextLineIndex
               Length = InStr(I, Header, vbCrLf, vbTextCompare)
               If Length > 0 Then
                 nextLineIndex = Length + 2
                 Length = Length - I
               Else
                 nextLineIndex = 0
                 Length = Len(Header) - I + 1
               End If
               GetHeaderText = GetHeaderText & Mid(Header, I, Length)
           Loop
       Else
           GetHeaderText = ""
       End If
   End Function

■ 新型iPod touch

何そのテロ的新製品。

CPUとカメラが変わっただけの、第６世代？　5Sなのか？

こないだ電池交換（という名の新品交換）したところだけど、32GBを速攻ぽちってしまいました。土曜日には届くでしょう。

GPSを待ち望んでいるのだが……（これは無理そうね）