3
4

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

Access VBA DAOとADOのフィールドタイプの定数の互換表ANSI-SQLとMSSQLServerとともに

Last updated at Posted at 2018-01-16

ADOとDAOの定数はずれている

なので今一つ一致しない。なのでANSISQLに引っ掛けて一覧表にしてみた
しかし日付周りが自信がない。またフィールドタイプはこれで全部ではない。
間違っている点があったらご指摘願いたい。

ANSI SQL のデータ型 MSAccess SQL のデータ型 別名 定数名DAO 定数名ADO Microsoft SQL Server のデータ型 メモなど ACCESS Create Tableデータ型
この行参考リンク先 https://msdn.microsoft.com/ja-jp/library/office/ff845405.aspx http://antonsan.net/study/excel/excel012.php ///Type プロパティの例 (Field) (VB)///https://docs.microsoft.com/ja-jp/sql/ado/reference/ado-api/datatypeenum SQL データ型
BIT、BIT VARYING BINARY (次の「メモ」を参照) VARBINARY、BINARY VARYING BIT VARYING dbBinary,dbVarBinary 9,17 adBinary,adVarBinary 128204 BINARY、VARBINARY Microsoft Access SQL のデータ型 BIT は、ANSI SQL のデータ型 BIT とは異なります。Microsoft Access SQL のデータ型 BINARY が ANSI SQL のデータ型 BIT と同じ役割を果たします。Microsoft Access SQL のデータ型 BIT に相当する ANSI SQL のデータ型はありません。
使用不可 BIT (次の「メモ」を参照) BOOLEAN、LOGICAL、LOGICAL1、YESNO dbBoolean 1 adBoolean 11 BIT なし BIT
使用不可 TINYINT INTEGER1、BYTE adTinyInt 16 TINYINT 1 バイトの符号付き整数を示します (DBTYPE_I1)。 Integer
使用不可 COUNTER (次の「メモ」を参照) AUTOINCREMENT なし なし なし なし (次の「メモ」を参照) なし
使用不可 MONEY CURRENCY dbCurrency 5 adCurrency 6 MONEY 通貨値を示します (DBTYPE_CY)。通貨型は小数点以下 4 桁の固定小数点の数値です。スケールが 10,000 の、8 バイトの符号付き整数で格納します。 MONEY
DATE、TIME、TIMESTAMP DATETIME DATE、TIME (次の「メモ」を参照) dbDate,dbTimeStamp 8,23 adDate,adDBTime,adDBTimeStamp 7134135 DATETIME データ型 TIMESTAMP を、データ型 DATETIME の別名として使用することはできません。/(Yyyymmddhhmmss と 10億分の端数) の日付/時刻スタンプを示します (DBTYPE_DBTIMESTAMP)。 DATETIME
使用不可 UNIQUEIDENTIFIER GUID dbGUID 15 adGUID 72 UNIQUEIDENTIFIER UNIQUEIDENTIFIER
REAL REAL SINGLE、FLOAT4、IEEESINGLE dbSingle adSingle 4 REAL 単精度浮動小数点値 (DBTYPE_R4) を示します。 REAL
DOUBLE PRECISION、FLOAT float DOUBLE、FLOAT8、IEEEDOUBLE、NUMBER (次の「メモ」を参照) dbDouble 7 adDouble 5 float 倍精度浮動小数点値 (DBTYPE_R8) を示します。 float
SMALLINT SMALLINT SHORT、INTEGER2 adSmallInt 2 SMALLINT 2 バイト符号付き整数 (DBTYPE_I2) を示します。
INTERVAL 使用不可 なし なし なし なし なし 使用不可 なし
使用不可 Image LONGBINARY、GENERAL、OLEOBJECT dbLongBinary 11 asLongVarBinary 205 Image ロング バイナリ型 (Long Binary) - OLE オブジェクト型 (OLE Object) Image
使用不可 TEXT (次の「メモ」を参照) LONGTEXT、LONGCHAR、MEMO、NOTE、NTEXT (次の「メモ」を参照) dbText,dbMemo 10,12 adLongVarChar,adLongVarWChar 201203 Text LONGTEXT 型フィールドでは、データは常に Unicode 表示形式で格納されます。 /データ型 TEXT を文字列の長さ (たとえば TEXT(25)) を指定しないで使用すると、LONGTEXT 型フィールドが作成されます。このため、CREATE TABLE ステートメントのデータ型と Microsoft SQL Server のデータ型の整合性を保つことが可能になります。
CHARACTER、CHARACTER VARYING、NATIONAL CHARACTER、NATIONAL CHARACTER VARYING CHAR (次の「メモ」を参照) TEXT(n)、ALPHANUMERIC、CHARACTER, STRING、VARCHAR、CHARACTER VARYING、NCHAR、NATIONAL CHARACTER、NATIONAL CHAR、NATIONAL CHARACTER VARYING、NATIONAL CHAR VARYING (次の「メモ」を参照) dbChar 18 adChar 129 CHAR、VARCHAR、NCHAR、NVARCHAR CHAR 型フィールドでは、データは常に Unicode 表示形式で格納されます。データ型 CHAR は、ANSI SQL のデータ型 NATIONAL CHAR に相当します。 /たとえば TEXT(25) のように、フィールドのデータ型が、文字列の長さを指定したデータ型 TEXT である場合、そのフィールドのデータ型はデータ型 CHAR と一致します。データ型が一致することによって、文字列の長さが指定されていない TEXT データ型と Microsoft SQL Server のデータ型の間の整合性が保たれると共に、以前に作成された Microsoft Jet 用のアプリケーションで使用されているデータ型との下位互換性が保たれます。

Access ユーザー インターフェイスおよび DAO のデータ型と、ADOX データ型との対応表

Access ユーザーインターフェイスのデータ型 DAO データ型 ADOX データ型
Yes/No 型 dbBoolean adBoolean
数値型 (FieldSize = バイト型) dbByte adUnsignedTinyInt
通貨型 dbCurrency adCurrency
日付/時刻型 dbDate adDate
数値型 (FieldSize = 小数型) dbDecimal adDecimal
数値型 (FieldSize = Double) dbDouble adDouble
数値型またはオートナンバー型 (FieldSize = レプリケーション ID 型) dbGUID adGUID
数値型 (FieldSize = 整数型) dbInteger adSmallInt
数値型またはオートナンバー型 (FieldSize = 長整数型) dbLong adInteger
OLE オブジェクト型 dbLongBinary adLongVarBinary
メモ型 dbMemo adLongVarWChar
数値型 (FieldSize = Single) dbSingle adSingle
テキスト型 dbText adVarWChar
ハイパーリンク型 dbMemo、およびdbHyperlinkFieldに設定された DAO Attributes プロパティ adLongVarWChar、および Jet OLEDB:Hyperlink に設定された ADOX プロバイダ別 Column プロパティ

フィールドの定義からCreate Table のSQLを作成する

注意点

完全ではなく簡易なものだがテキストくらいならこれで行ける

表示形式とかはできない。欠点はあるもののSQLを一から作ったり、CreateFildで書くよりはとても楽。

1列目は名前がID 主キー固定

普通そうなんじゃないかな。違ったら変えてください。

ハイパーリンクはメモ型になる、Null値要求は一部のみ

SQLは作成も変更もできないので無理。この理由は英語版のヘルプから下記に引用しておいた。しかし探しづらい。3年くらい探したんじゃないかな。NULL値はあとでプロパティを吐き出すコードを作っておいたので、それで見ながら手動で買えてください。

コード

Sub makeCreateTableSQL()
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim fld As DAO.Field
Dim tdf As TableDef: Set tdf = cDB.TableDefs("Tablename")
Dim buf As String
Dim i As Long, ia As Long
Dim cnt As Long
Const NotNullRequiredTrue As String = " NOT NULL"
cnt = 0
buf = "Dim cDB As Dao.Database : Set cDB = CurrentDb" & vbCrLf & _ 
 "Dim fld As dao.Field, tdf As Tabledef : Set tdf = cDb.TableDefs(" & tdf.Name & )" & vbCrLf & _
 "Dim sSQL As String" & vbCrLf & _
"sSQL = " & Chr(34) & "Create Table [" & tdf.Name & "](ID Counter Primary Key,"
For i = 1 To tdf.Fields.Count - 1
Set fld = tdf.Fields(i)
If cnt > 400 Then
buf = buf & Chr(34) & " & vbCrLf & _ " & vbCrLf & Chr(34)
cnt = 0
End If
Select Case fld.Type
Case Is = dbByte
cnt = cnt + Len("[" & fld.Name & "]" & " Intger1,")
buf = buf & " [" & fld.Name & "]" & " Intger1,"

Case Is = dbLong
If fld.Required = True Then
cnt = cnt + Len("[" & fld.Name & "]" & " Long " & NotNullRequiredTrue & ",")
buf = buf & " [" & fld.Name & "]" & " Long " & NotNullRequiredTrue & ","
Else
cnt = cnt + Len("[" & fld.Name & "]" & " Long,")
buf = buf & " [" & fld.Name & "]" & " Long,"
End If
Case Is = dbCurrency
If fld.Required = True Then
cnt = cnt + Len("[" & fld.Name & "]" & " MONEY " & NotNullRequiredTrue & ",")
buf = buf & " [" & fld.Name & "]" & " MONEY " & NotNullRequiredTrue & ","
Else
cnt = cnt + Len("[" & fld.Name & "]" & " MONEY,")
buf = buf & " [" & fld.Name & "]" & " MONEY,"
End If
Case Is = dbGUID
cnt = cnt + Len("[" & fld.Name & "]" & " GUID,")
buf = buf & " [" & fld.Name & "]" & " GUID,"
Case Is = dbText
If fld.Required = True Then
cnt = cnt + Len("[" & fld.Name & "]" & " Text(" & fld.Size & ") " & NotNullRequiredTrue & ",")
buf = buf & " [" & fld.Name & "]" & " Text(" & fld.Size & ") " & NotNullRequiredTrue & ","
Else
cnt = cnt + Len("[" & fld.Name & "]" & " Text(" & fld.Size & ") ,")
buf = buf & " [" & fld.Name & "]" & " Text(" & fld.Size & ") ,"
End If
Case Is = dbDate
cnt = cnt + Len("[" & fld.Name & "]" & " DateTime,")
buf = buf & " [" & fld.Name & "]" & " DateTime,"
Case Is = dbDouble
cnt = cnt + Len("[" & fld.Name & " NUMERIC,")
buf = buf & " [" & fld.Name & "]" & " NUMERIC,"
Case Is = dbBoolean
cnt = cnt + Len("[" & fld.Name & " ] YESNO,")
buf = buf & " [" & fld.Name & " ] YESNO,"
Case Is = dbBinary
cnt = cnt + Len("[" & fld.Name & "]" & " BINARY,")
buf = buf & " [" & fld.Name & "]" & " BINARY,"
Case Is = dbInteger
cnt = cnt + Len("[" & fld.Name & "]" & " SHORT,")
buf = buf & " [" & fld.Name & "]" & " SHORT,"
Case Is = dbSingle
cnt = cnt + Len("[" & fld.Name & "]" & " SINGLE,")
buf = buf & " [" & fld.Name & "]" & " SINGLE,"
Case Is = dbMemo
cnt = cnt + Len("[" & fld.Name & "]" & " LongText,")
buf = buf & " [" & fld.Name & "]" & " LongText,"
Case Is = dbLongBinary
cnt = cnt + Len("[" & fld.Name & "]" & " IMAGE,")
buf = buf & " [" & fld.Name & "]" & " IMAGE,"
Case Is = dbChar
If fld.Required = True Then
cnt = cnt + Len("[" & fld.Name & "]" & " CHAR " & NotNullRequiredTrue & ",")
buf = buf & " [" & fld.Name & "]" & " CHAR " & NotNullRequiredTrue & ","
Else
cnt = cnt + Len("[" & fld.Name & "]" & " CHAR(" & fld.size & "),")
buf = buf & " [" & fld.Name & "]" & " CHAR(" & fld.size & "),"
End If
Case Else
End Select
Next
buf = Mid(buf, 1, Len(buf) - 1)
buf = buf & ")" & ";" & Chr(34)
Debug.Print buf
End Sub

公式のSQLの解説はDDLで検索しないとみつからない。

Microsoft Access データ型

DAOとADOを同じテーブルで比較するコード

Sub test()
'For access
Const cnsFileFullPathName = "C:hoge\fieldproperty.csv" '保存先の指定
Const TbName = "TableName" 'カレントデータベースの解析したいテーブルの名前
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim fld As DAO.Field, tdf As TableDef, prp As Property, prps As Properties, SubPrp As Property
Dim adTbl As ADOX.Table
Dim CAT As ADOX.Catalog: Set CAT = New ADOX.Catalog
Dim adCol As ADOX.Column
Dim adPrps As ADOX.Properties, adPrp As ADOX.Property
Dim varVal As Variant, varSubVal As Variant, i As Long
Dim sr As ADODB.Stream: Set sr = New ADODB.Stream

sr.Charset = "UTF-8"
sr.Type = adTypeText
sr.LineSeparator = adCRLF
sr.Mode = adModeReadWrite
sr.Open
sr.WriteText "DAO/ADOX,TableName,FieldName,FieldType,Inherit/Attributes,Name,Type,Value,TypeEnum,SubProperty,err.number,err.description", adWriteLine
'Daoの場合
Set fld = New DAO.Field
Set tdf = cDB.TableDefs(TbName)
'単独のコラム(フィールド)用
Set fld = tdf.Fields(2) 'DAOは最初が0から
Debug.Print fld.Name, fld.Type
On Error Resume Next
'Table 自体のプロパティ
'Table 自体のプロパティ
For i = 1 To tdf.Properties.Count
Set prp = tdf.Properties.Item(i)
If Err.Number <> 0 Then
  'Debug.Print tdf.Name & "," & fld.Name & "," & prp.Inherited & "," & prp.Name & "," & prp.Type & "," & _
  fnGUIDtrans(prp.Name, prp.Value) & "," &  EnumRtn("dao", prp.Value) & "," &"," & "," & "," & "," & "," & Err.Number & "," & Err.Description
  sr.WriteText "Dao" & "," & tdf.Name & "," & "Table" & "," & "ProPerty" & "," & prp.Inherited & "," & prp.Name & "," & prp.Type & "," & _
  prp.Value & ",," & "," & ", " & Err.Number & "," & Err.Description, adWriteLine: Err.Clear
  Else
  sr.WriteText "Dao" & "," & tdf.Name & "," & "Table" & "," & "ProPerty" & "," & prp.Inherited & "," & prp.Name & "," & prp.Type & "," & _
  fnGUIDtrans(prp.Name, prp.Value) & ",," & "," & "," & "," & ",", adWriteLine
  End If
Next
'''Field
For Each fld In tdf.Fields
For Each prp In fld.Properties
'データ型
varVal = EnumRtn("dao", prp.Type)
'エラーを分ける
If Err.Number <> 0 Then
  'Debug.Print tdf.Name & "," & fld.Name & "," & prp.Inherited & "," & prp.Name & "," & prp.Type & "," & fnGUIDtrans(prp.Name, prp.Value) & "," &  EnumRtn("dao", prp.Value) & "," &"," & "," & "," & "," & "," & Err.Number & "," & Err.Description
  sr.WriteText "Dao" & "," & tdf.Name & "," & fld.Name & "," & EnumRtn("dao", fld.Type) & "," & prp.Inherited & "," & prp.Name & "," & prp.Type & "," & fnGUIDtrans(prp.Name, prp.Value) & "," & EnumRtn("dao", prp.Value) & "," & ", , , , ," & Err.Number & "," & Err.Description, adWriteLine: Err.Clear
  Else
  sr.WriteText "Dao" & "," & tdf.Name & "," & fld.Name & "," & EnumRtn("dao", fld.Type) & "," & prp.Inherited & "," & prp.Name & "," & prp.Type & "," & fnGUIDtrans(prp.Name, prp.Value) & "," & EnumRtn("dao", prp.Value) & "," & "," & "," & "," & ",", adWriteLine
  End If
If Not prp.Properties Is Nothing Then
For Each SubPrp In fld.Properties
'データ型サブ
  varSubVal = EnumRtn("dao", SubPrp.Type)
 'エラーを分けるサブ
If Err.Number <> 0 Then
'Debug.Print "DAO" & "," & tdf.Name & "," & fld.Name & "," & SubPrp.Inherited & "," & SubPrp.Name & "," & SubPrp.Type & "," & fnGUIDtrans(SubPrp.Name, SubPrp.Value) & "," & varSubVal  & "," &"," & fld.Name & ":" & prp.Name & "  subPropety"
sr.WriteText "DAO" & "," & tdf.Name & "," & fld.Name & "," & EnumRtn("dao", fld.Type) & "," & SubPrp.Inherited & "," & SubPrp.Name & "," & SubPrp.Type & "," & fnGUIDtrans(SubPrp.Name, SubPrp.Value) & "," & varSubVal & "," & ",""" & fld.Name & ":" & prp.Name & "  subPropety""" & " , ," & Err.Number & "," & Err.Description, adWriteLine: Err.Clear
Else
sr.WriteText "DAO" & "," & tdf.Name & "," & fld.Name & "," & EnumRtn("dao", fld.Type) & "," & SubPrp.Inherited & "," & SubPrp.Name & "," & SubPrp.Type & "," & fnGUIDtrans(SubPrp.Name, SubPrp.Value) & "," & varSubVal & "," & ",""" & fld.Name & ":" & prp.Name & "  subPropety""", adWriteLine
End If
Next
End If
Next
Next
Set tdf = Nothing
CAT.ActiveConnection = CurrentProject.Connection
Set adTbl = CAT.Tables(TbName)
'単独のコラム(フィールド)用
Set adCol = adTbl.Columns(0) '列順は1から始まり終わりが0になる
Set adPrps = adCol.Properties
Debug.Print adCol.Name, adCol.Type
On Error Resume Next
For Each adCol In adTbl.Columns
For Each adPrp In adPrps
'データ型
varVal = EnumRtn("ado", adPrp.Type)
'書き込み
sr.WriteText "ADOX," & adTbl.Name & "," & adCol.Name & "," & EnumRtn("ado", adCol.Type) & "," & adPrp.Attributes & "," & adPrp.Name & "," & adPrp.Type & "," & fnGUIDtrans(adPrp.Name, adPrp.Value) & "," & varVal, adWriteLine
Next
Next
Set CAT = Nothing
With CreateObject("Scripting.Filesystemobject")
If .FileExists(cnsFileFullPathName) Then .DeleteFile cnsFileFullPathName, True
End With
sr.SaveToFile cnsFileFullPathName, adSaveCreateNotExist
sr.Close
Set sr = Nothing
End Sub

Function fnGUIDtrans(fldname As String, val As Variant) As Variant
'GUIDを返す
Dim i As Long
Dim buf As String
Dim cnt As Long
cnt = 1
buf = ""
If fldname = "GUID" Then
For i = LBound(val) To UBound(val)
buf = buf & CStr(Hex(val(i)))
If cnt = 4 Or cnt = 6 Or cnt = 8 Or cnt = 10 Then buf = buf & "-"
cnt = cnt + 1
Next
fnGUIDtrans = CStr("""GUID={" & buf & "}""")
Else
fnGUIDtrans = val
End If
End Function

Function EnumRtn(daoado As String, varvalue As Long)
'Dao,Adoのデータタイプの定数を返す
'Access 2016 まで対応
Dim ArDN, ArDVl, ArDat, ArDSz, iDao As Long
Dim ArAN, ArAVL, ArAat, ArASz, iAdo As Long
Dim varVal As Variant, varSubVal As Variant
ArDN = Split("dbText,dbComplexText,dbMemo,dbByte,dbComplexByte,dbInteger,dbComplexInteger,dbLong,dbComplexLong,dbSingle,dbDouble,dbComplexDouble,dbGUID,dbComplexGUID,dbDecimal,dbComplexDecimal,dbDate,dbCurrency,dbBoolean,dbLongBinary,dbAttachment,dbBinary,dbBigInt,dbTime,dbTimeStamp,dbVarBinary,dbFloat", ",")
ArDVl = Split("10,109,12,2,102,3,103,4,104,6,7,106,15,107,20,108,8,5,1,11,101,9,16,22,23,17,21", ",")
ArAN = Split("adVarWChar,adWChar,adLongVarWChar,adUnsignedTinyInt,adSmallInt,adInteger,adSingle,adDouble,adGUID,adNumeric,adDate,adCurrency,adBoolean,adLongVarBinary,adVarBinary,adBigInt,adArray,adChapter,adChar,adDBDate,adDBTime,adDBTimeStamp,adEmpty,adError,adIDispatch,adIUnknown,adLongVarChar,adNumeric,adPropVariant,adTinyInt,adUnsignedBigInt,adUnsignedInt,adUnsignedSmallInt,dUnsignedTinyInt,adUserDefined,adVariant,adVarNumeric,adWChar,adBSTR,adBinary,adFileTime", ",")
ArAVL = Split("202,130,203,17,2,3,4,5,72,131,7,6,11,205,204,20,8192,136,129,133,134,135,0,10,9,13,201,131,138,16,21,19,18,17,132,12,139,130,8,128,64", ",")
On Error GoTo Terminator
If daoado = "dao" Then
For iDao = LBound(ArDVl) To UBound(ArDVl)
If varvalue = CLng(ArDVl(iDao)) Then EnumRtn = ArDN(iDao): Exit Function
Next iDao
Else
For iAdo = LBound(ArAVL) To UBound(ArAVL)
If varvalue = CLng(ArAVL(iAdo)) Then EnumRtn = ArAN(iAdo): Exit Function
Next iAdo

End If
EnumRtn = "failed"
Exit Function
Terminator:
Err.Clear
EnumRtn = "" 'エラーの時は何も返さない
Exit Function
End Function
Microsoft Access のデータ型 データ型 (CREATETABLE) ODBC SQL データ型
BIGBINARY [1] LONGBINARY SQL_LONGVARBINARY
BINARY BINARY SQL_BINARY
BIT BIT SQL_BIT
カウンター カウンター SQL_INTEGER
通貨 CURRENCY SQL_NUMERIC
日付/時刻 DATETIME SQL_TIMESTAMP
GUID GUID SQL_GUID
長いバイナリ LONGBINARY SQL_LONGVARBINARY
長いテキスト 長いテキスト SQL_LONGVARCHAR[2] SQL_WLONGVARCHAR [3]
メモ 長いテキスト SQL_LONGVARCHAR[2] SQL_WLONGVARCHAR [3]
数 (フィールド = 単精度) Single SQL_REAL
数 (フィールド = 倍精度) DOUBLE SQL_DOUBLE
数 (フィールド = バイト) 符号なしバイトUNSIGNED BYTE SQL_TINYINT
数 (フィールド サイズが整数型) Short SQL_SMALLINT
数 (フィールドLONG Integer) LONG SQL_INTEGER
NUMERIC NUMERIC SQL_NUMERIC
OLE LONGBINARY SQL_LONGVARBINARY
[TEXT] VARCHAR SQL_VARCHAR[1] SQL_WVARCHAR [2]
VARBINARY VARBINARY SQL_VARBINARY

[1] Access 4.0 applications only. Maximum length of 4000 bytes. Behavior similar to LONGBINARY.
[2] ANSI applications only.
[3] Unicode and Access 4.0 applications only.

SQLはDDLで解説を検索すると英語版がでてくる

How to use common Data Definition Language (DDL) SQL statements for the Jet database engine

ハイパーリンク、ルックアップがSQLで作成変更できない

注:Microsoft Access DDL SQLステートメントを使用して、「オートナンバーレプリケーション」、「ハイパーリンク」、または「ルックアップ」タイプフィールドを作成することはできません。 これらのフィールドの種類は、Jetの元のフィールドの種類ではなく、Microsoft Accessユーザーインターフェイスでのみ作成および使用できます。

固定長バイナリフィールドはSQLでしかつくれない

MyBinaryフィールドは特別な固定長のバイナリフィールドですが、Microsoft Accessユーザーインターフェイスでは作成できません
テーブルや Access SQL を使用してテーブルやインデックスを作成、削除します

テーブルはSQL DDLステートメントを使用して作成できます。

名前にスペースが入るときは[]で囲む。Text、Charは長さを指定した方が良い

  • フィールド名にスペースまたはその他の英数字以外の文字が含まれる場合、フィールド名を角かっこ ([ ]) で囲む必要があります。Docmdの時はいらない。
  • テキスト フィールドの長さを宣言しない場合、フィールドの長さは既定の255文字までとなります。必ずフィールドの長さを定義して、一貫性を保ち、コードを読みやすくするようにしてください。

以上を踏まえたSQL(DDL データ定義言語)で作れるすべてのタイプのテーブル

Hyperlink、詳細の追加をあわせて

MS公式を上のプロパティ掃き出しツールで使えるよう、Counterを最初に、名前をIDに、主キーを作りました
単純にSQLで作るだけでなくHyperlinkFieldを追加するようにしました。
またテーブルの説明とフィールドの説明がDaoで追加されます。
このようにSQLで作った後にフィールドをDAOで追加するとハイパーリンクフィールドもスムーズに作れます。
No44616.テーブルの説明をVBAで追加したい

コード

Sub MakeDDLSQLCreateAlltypeTable()
'For MicroSoft Access
'[How to use common Data Definition Language (DDL) SQL statements for the Jet database engine](https://support.microsoft.com/ja-jp/help/180841/how-to-use-common-data-definition-language-ddl-sql-statements-for-the)
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim fld As DAO.Field, tdf As DAO.TableDef, prp As Property, prps As Properties, SubPrp As Property
Dim asRs As ADODB.Recordset, adCN As ADODB.Connection, adCNCmd As ADODB.Command
Dim adTbl As ADOX.Table
Dim CAT As ADOX.Catalog: Set CAT = New ADOX.Catalog
Dim adCol As ADOX.Column
Dim adPrps As ADOX.Properties, adPrp As ADOX.Property
Dim sr As ADODB.Stream: Set sr = New ADODB.Stream

Dim sSQL As String
Dim i  As Long
On Error Resume Next
DoCmd.DeleteObject acTable, "Test All Types"
On Error GoTo 0
sSQL = _
   "CREATE TABLE [Test All Types](" & _
      "ID COUNTER Primary Key," & _
      "[My てすと]  TEXT(50)," & _
      "[MyChar]  Char(50)," & _
      "MyMemo  MEMO," & _
      "MyByte BYTE," & _
      "MyInteger INTEGER," & _
      "MyLong LONG," & _
      "MySingle SINGLE," & _
      "MyDouble DOUBLE," & _
      "MyCurrency CURRENCY," & _
      "MyReplicaID  GUID," & _
      "MyDateTime  DATETIME," & _
      "MyYesNo  YESNO," & _
      "MyOleObject  LONGBINARY," & _
      "MyBinary  BINARY(50)" & _
    ");"
DoCmd.RunSQL sSQL
DoCmd.DeleteObject acTable, "Test All Types"
'Add HyperlinkField (DAO)
Application.CurrentDb.Execute (sSQL) 'SAME DoCmd.RunSQL sSQL
Set tdf = CurrentDb.TableDefs("Test All Types")
Set fld = CurrentDb.TableDefs("Test All Types").CreateField("My HyperLink", dbMemo)
fld.Attributes = dbHyperlinkField
CurrentDb.TableDefs("Test All Types").Fields.Append fld
'Add Table And Filed Description
On Error GoTo 0
    ' 定数/変数宣言部
Const PROP_NOT_FOUND = 3420
Const WRONG_OBJECT = 3270
On Error Resume Next
'tableの詳細--------------------------
tdf.Properties("Description").Value = "これはSQLで作ることができるすべてのタイプのフィールドを含んだテーブルです"
If Err.Number = PROP_NOT_FOUND Then
Set prp = tdf.CreateProperty
With prp
.Name = "Description"
.Type = dbText
.Value = "SQLで作ることができるすべてのタイプのフィールドを含んだテーブルです"
End With
CurrentDb.TableDefs("[Test All Types]").Properties.Append prp
CurrentDb.TableDefs("[Test All Types]").Properties.Refresh
Application.RefreshDatabaseWindow
cDB.TableDefs.Refresh
Err.Clear
End If
'Tableの詳細の更新
CurrentDb.TableDefs("[Test All Types]").Properties("Description").Value = "これはSQLで作ることができるすべてのタイプのフィールドを含んだテーブルです"
'Field(1)の設定と更新(エラー対応版)
Set prp = CurrentDb.TableDefs("[Test All Types]").Fields(1).Properties("Description").Value = "link"
If Err.Number = WRONG_OBJECT Then
Set prp = CurrentDb.TableDefs("[Test All Types]").Fields(1).CreateProperty
With prp
.Name = "Description"
.Type = dbText
.Value = "Text Filed 50 Characters"
End With
CurrentDb.TableDefs("Test All Types").Fields("[My てすと]").Properties.Append prp
CurrentDb.TableDefs("Test All Types").Fields(1).Properties.Refresh
Err.Clear
End If
'Field(2)の設定と更新(簡易版)。SQLで作ったばかりなら詳細がないのでこちらでもよい
Set prp = CurrentDb.TableDefs("[Test All Types]").Fields(2).CreateProperty
With prp
.Name = "Description"
.Type = dbText
.Value = "CHARで作ったフィールドだがTextと同じタイプになる"
End With
CurrentDb.TableDefs("Test All Types").Fields("[MyChar]").Properties.Append prp
CurrentDb.TableDefs("Test All Types").Fields(2).Properties.Refresh
'Drop Table Is Delete Table. Same DoCmd.RunSQL sSQL
If MsgBox("Drop Table", vbYesNo, "Drop Table Run?") = vbYes Then DoCmd.RunSQL "DROP TABLE [Test All Types]"
End Sub

The Columns of a Table
英語だがSQL、DAOで同じフィールドを作成するので比較になる。
VBA によるフィールド作成(MDB & DAO)対象バージョン:7.0, 97, 2000M最終更新日:1999/12/30 ( オリジナル作成日:1999/12/30 ) 17年前のものだがほぼそのまま使える

Field type reference - names and values for DDL, DAO, and DOX これも8年前のもの Excel2013は反映していない
DataTypeEnum 列挙 (DAO)Access2013以降のDaoの定数。誤訳がある。

3
4
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
3
4

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?