ACCESS VBA OutLookのメールのプロパティをテーブルに記録するマクロを改造する（1） How to make Mail Property access table

##GeoCitiesのサンプル

No.55 Access_テーブルを作成する→Outlook2010のMailItemオブジェクトメンバーのプロパティ一覧のフィールドを作成する(ADOX.Columns.Appendメソッド)
No.599 Outlook→Access_全ての受信トレイのフォルダのMailItemオブジェクトメンバーのプロパティ一覧を取得する(Outlook.MailItem.Actionsプロパティ)

##改善内容
〇しかしPropatiesのRTFの設定がテキストになっている無理では。。。
〇値を要求しないとしても値がないところにはNullを入れる
〇また、Propatiesなどデータが取れないプロパティがあり、このままではテーブルになぜかメールのプロパティリストができない。
###リッチテキスト形式(Rich text)(1)解決が困難　ACCESS2013 LATERで確認
RTFプロパティのためにテーブルにリッチテキストフィールドを設定するのが難しい。

How to set rich text property when creating memo field in DAO?
Dim db as database :set db=currentdb
Dim fld as dao.field
dim tdf as dao.tabledef
で
set tdf= db.createtabledef("Hogehoge")
Set fld = tdf.CreateField("memo_field", dbMemo)
tdf.Fields.Append fld
tdf.Fields(fld.Name).Properties.Append fld.CreateProperty("TextFormat", dbByte, acTextFormatHTMLRichText)
※dbByte=2 acTextFormatHTMLRichText=1

Access 2013はこれでもエラーになる
メッセージはつぎのようなもの
エラーメッセージ：実行時エラー（3219）無効な処理です
この例はエラーメッセージ集の下記サイトにもない
コード3219はあるがメッセージは異なる
http://www.geocities.jp/samplecode_20131004/Category_runtimeerror.html

###リッチテキスト形式(Rich text)(2)解決方法
Access VBA create table and format fields
こちらのsampleはACCESSのテーブルにDAOで、リッチテキスト形式のフィールドを設定できる。
SetDaoProperty関数が重要
こちらのサンプルを改造すると、
Set myField = myTable.Fields("RTFBody")
Call SetDAOProperty(myField, "TextFormat", dbByte, 1)
は有効に作用する
また下記の
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1458626959
表示形式の設定
Dim prp As Property
Set prp = tdf.Fields("数値(整数型)").CreateProperty("Format", dbText, "#,##0")
tdf.Fields("数値(整数型)").Properties.Append prp
こちらにも使えると考えられる

CreateTable.BAS

Sub CreateTable()
Dim db As DAO.Database
Dim myTable As DAO.TableDef
Dim myField As DAO.Field
Set db = CurrentDb
Set myTable = db.CreateTableDef("TestTable")
With myTable
.Fields.Append .CreateField("DateD", dbDate)
.Fields.Append .CreateField("Description", dbText)
.Fields.Append .CreateField("Num1", dbDouble)
.Fields.Append .CreateField("Num2", dbDouble)
.Fields.Append CreateField("RTFBody", dbMemo, 100)
End With
db.TableDefs.Append myTable
Set myField = myTable.Fields("DateD")
Call SetDAOProperty(myField, "Format", dbText, "Short Date")
Set myField = myTable.Fields("Num1")
Call SetDAOProperty(myField, "DecimalPlaces", dbByte, 2)
Call SetDAOProperty(myField, "Format", dbText, "Standard")
Set myField = myTable.Fields("RTFBody")
Call SetDAOProperty(myField, "TextFormat", dbByte, 1)
Application.RefreshDatabaseWindow

Set myField = Nothing
Set myTable = Nothing
Set db = Nothing

End Sub

Function SetDAOProperty( _
WhichObject As Object, _
PropertyName As String, _
PropertyType As Integer, _
PropertyValue As Variant _
) As Boolean
On Error GoTo ErrorHandler
Dim prp As DAO.Property

WhichObject.Properties(PropertyName) = PropertyValue
WhichObject.Properties.Refresh
SetDAOProperty = True

Cleanup:
Set prp = Nothing
Exit Function

ErrorHandler:
Select Case Err.Number
Case 3270 ' "Property not found"
Set prp = WhichObject.CreateProperty( _
PropertyName, _
PropertyType, _
PropertyValue _
)
WhichObject.Properties.Append prp
WhichObject.Properties.Refresh
SetDAOProperty = True
Case Else
MsgBox Err.Number & ": " & Err.Description
SetDAOProperty = False
End Select
Resume Cleanup

End Function