各テーブルの列名を一覧で取得する関数
すごく面倒だったのでググった内容を基に関数を作成。
事前準備
- テーブル「W_TABLE_LIST」の作成
- table_name：テキスト型、テーブル名を格納
- col_name：テキスト型、列名を格納
- col_type：テキスト型、列の型名を格納
- col_size：テキスト型、列のサイズを格納
ソース
'各クエリのSQL文をテーブルに格納する関数 Public Sub GetField() On Error GoTo Err_GetField Dim DB As DAO.Database Dim Tableloop As DAO.TableDef Dim Fld As DAO.Field Dim strTablename As String Dim Tdf As DAO.TableDef Dim strSQL As String 'SQL文 Dim strType As String '型名 ''''''''''''''''''''''''''''''''''''''''''''''''''' ''typeの置換は定数でselect case ' '1: dbBoolean ' '2: dbByte ' '3: dbInteger ' '4: dbLong ' '5: dbCurrency ' '6: dbSingle ' '7: dbDouble ' '8: dbDate ' '10: dbText ' '11: dbLongBinary ' '12: dbMemo ' '15: dbGUID ' '18: dbChar ' '20: dbDecimal ' '21: dbFloat ' ''確認用 ' Debug.Print dbBoolean & vbTab & ": dbBoolean" ' Debug.Print dbByte & vbTab & ": dbByte" ' Debug.Print dbInteger & vbTab & ": dbInteger" ' Debug.Print dbLong & vbTab & ": dbLong" ' Debug.Print dbCurrency & vbTab & ": dbCurrency" ' Debug.Print dbSingle & vbTab & ": dbSingle" ' Debug.Print dbDouble & vbTab & ": dbDouble" ' Debug.Print dbDate & vbTab & ": dbDate" ' Debug.Print dbText & vbTab & ": dbText" ' Debug.Print dbLongBinary & vbTab & ": dbLongBinary" ' Debug.Print dbMemo & vbTab & ": dbMemo" ' Debug.Print dbGUID & vbTab & ": dbGUID" ' Debug.Print dbChar & vbTab & ": dbChar" ' Debug.Print dbDecimal & vbTab & ": dbDecimal" ' Debug.Print dbFloat & vbTab & ": dbFloat" ' ''''''''''''''''''''''''''''''''''''''''''''''''''' 'レコード削除・追加時の警告メッセージOFF DoCmd.SetWarnings False 'テーブルのリストを初期化 DoCmd.RunSQL "DELETE * FROM W_table_list" 'DBの各テーブル名を見て、システムテーブルで無いものを判別して処理 Set DB = CurrentDb For Each Tableloop In DB.TableDefs strTablename = Tableloop.Name If Left(strTablename, 2) <> "MS" Then Set Tdf = DB.TableDefs(strTablename) For Each Fld In Tdf.Fields 'typeの置換 Select Case Fld.Type Case 1 'dbBoolean strType = "Boolean" Case 2 'dbByte strType = "Byte" Case 3 'dbInteger strType = "Integer" Case 4 'dbLong strType = "Long" Case 5 'dbCurrency strType = "Currency" Case 6 'dbSingle strType = "Single" Case 7 'dbDouble strType = "Double" Case 8 'dbDate strType = "Date" Case 10 'dbText strType = "Text" Case 11 'dbLongBinary strType = "OLEオブジェクト" Case 12 'dbMemo strType = "Memo" Case 15 'dbGUID strType = "オートナンバー" Case 18 'dbChar strType = "Char" Case 20 'dbDecimal strType = "Decimal" Case 21 'dbFloat strType = "Float" Case Else 'ERROR? strType = "ERROR?(" & Fld.Type & ")" End Select 'テーブルに格納 strSQL = "INSERT INTO W_table_list (table_name, col_name, col_type, col_size) values (" & _ """" & strTablename & """, """ & Fld.Name & """, """ & strType & """, """ & Fld.Size & """)" DoCmd.RunSQL strSQL Next Fld End If Next Tableloop '結果見たいからテーブル初期化しない Exit_GetField: 'DBクローズ、レコード削除・追加時の警告メッセージON、処理完了 DB.Close Set DB = Nothing MsgBox "完了しました。" Exit Sub Err_GetField: MsgBox Err.Description Resume Exit_GetField End Sub
