Outlook 2007 の受信メールで、本文の一部を集計しようと思ったので、Microsoft Visual Basicなるものを試してみたので、コードをメモしておきます。

とりあえず、以下のサイトを参考に四苦八苦してみる事に。

• Outlook VBA マクロ、はじめの一歩
• 決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロ

以下のようなメールからアンケートの結果を取り出してみる

[件名] ---------------

注文メール

[本文] ---------------

名前    山田太郎

性別    男性

アンケート    Outlook 2007

商品    hogehoge

マクロの作成

メールの本文から、アンケート結果を取り出してCSVに書き込んでみる。

' シングルクォーテーションでコメントアウト
' Public の中にプログラムを書いていく
Public Sub outputcsv()
    ' CSVファイルのパス（これは定数だな）
    Const CSV_PATH = "c:outlook_csvoutput.csv" ' (;)とかは不要みたい
    ' Dim が変数の宣言になるのかな？
    Dim objItem
    Dim objFSO
    Dim csvfile
    ' Set はオブジェクトを代入する時に使用するみたい
    Set csvfile = Nothing
    ' Dim は使用しなくていいみたい
    num = 0
    ' オブジェクトを指定（ファイルの操作などをするオブジェクト）
    Set objFSO = CreateObject("Scripting.FileSystemObject")
 
    ' foreach 文（表示中の受信フォルダ内のアイテム全て）
    For Each objItem In ActiveExplorer.CurrentFolder.Items
        ' if 文（Thenってなに？、== じゃないの？）
        If objItem.Subject = "注文メール" Then
            ' objItem.Subject：件名
            ' objItem.Body：本文
            ' objItem.ReceivedTime：受信日時
 
            ' 値定義
            itemQA = getText("アンケート", objItem.Body) ' アンケート取得
            itemDatetime = Format(objItem.ReceivedTime, "yyyy-mm-dd hh:nn:ss") ' 受信日時取得
 
            ' 指定したファイルの読み書きが出来る
                ' 第1引数：ファイルパス
                ' 第2引数：入出力モード（1：読込、2：書込、8：追記）
                ' 第3引数：新規作成（True or False）
                ' 第4引数：文字コード（0：ASCII、-1：Unicode、2：システム規定値）
            Set csvfile = objFSO.OpenTextFile(CSV_PATH, 8, True, 0)
 
            If num = 0 Then
                ' CSVのフィールド名定義
                csvfile.writeline "id,qa,datetime"
            End If
 
            num = num + 1
 
            ' CSV値定義
            csvfile.writeline num & "," & itemQA & "," & itemDateTime
        End If
    Next
 
    ' オブジェクトを閉じる？
    If Not csvfile Is Nothing Then
        csvfile.Close
    End If
End Sub

getText()関数

指定した文字列の行末の文字列を取得する関数。

Private Function getText(strTarget As String, strBody As String) As String
    Dim leng_s As Long ' 指定文字の開始位置
    Dim leng_e As Long ' 指定文字の終了位置
    leng_s = InStr(strBody, strTarget) ' 本文から指定文字の位置を返す
 
    If leng_s > 0 Then
        leng_s = leng_s + Len(strTarget) ' 文字の開始位置に文字数を足す
        leng_e = InStr(leng_s, strBody, vbCrLf) ' 指定文字の末尾から改行文字までの位置を返す
        strAns = Trim(Mid(strBody, leng_s, leng_e - leng_s)) ' 指定の文字間を切り取り、空白文字を削除
 
        ' 関数名が return の変わり？
        getText = Replace(strAns, vbTab, "") ' タブ文字を置換
    Else
        getText = "" ' 指定文字が無ければ空文字を返す
    End If
End Function