Outlookのマクロを使って、受信したメールを自動で集計する方法を教えてください。

次の点を注意してプログラミングしてください。

1.店名は楽に集計するため、ハッシュ処理を使用しています。

　→参照設定で「Microsoft Scripting Runtime」を指定してください。

2.フォルダー名（Set myFolderの命令）を必要なら変更してください。

3.csv出力先を指定してください。表示は\ですが半角の￥に修正してください。

4.フォルダーのすべてを集計していますが、受信日付で不要分は読み捨てることも必要だと思います。

5.店名、日時毎に集計しています。

6.Outlook2007で作成しました。2003なら多少変更が必要になるかも知れません。

Option Explicit

Sub 集計()

　Const csv出力先 = "D:\集計データ.CSV"

　Dim myOlapp 　　　As New Outlook.Application

　Dim myNameSpace　As Outlook.NameSpace

　Dim myFolder　　　As Outlook.Folder

　Dim I As Integer

　Dim 受信日時　As Date

　Dim 件名　　　As String

　Dim 内容　　　As String

　Dim 店集計　　As Scripting.Dictionary

　Set 店集計 = New Scripting.Dictionary

　Set myNameSpace = myOlapp.GetNamespace("MAPI")

　Set myFolder = myNameSpace.Folders.Item("個人用フォルダ").Folders("受信トレイ")

　With myFolder

　　For I = 1 To .Items.Count

　　　件名 = .Items(I).Subject

　　　受信日時 = .Items(I).ReceivedTime

　　　内容 = Trim(.Items(I).Body)

　　　件名 = 件名 + Format(受信日時, ",YYYY年MM月DD日 HH時MM分")

　　　If 店集計.Exists(件名) Then

　　　　　店集計.Item(件名) = Val(Split(店集計.Item(件名), ",")(0)) + Val(Split(内容, ",")(0)) & "," & _

　　　　　　　　　　　　　　　　　　　Val(Split(店集計.Item(件名), ",")(1)) + Val(Split(内容, ",")(1))

　　　Else

　　　　　店集計.Add 件名, 内容

　　　End If

　　Next I

　End With

　Open csv出力先 For Output As #1

　For I = 0 To 店集計.Count - 1

　　Print #1, 店集計.Keys(I) & "," & 店集計.Item(店集計.Keys(I))

　Next I

　Close

End Sub