access vba データベースのテーブル名,フィルド名、データ型の一覧をエクセルに簡単に出力出来るフォーム

accessデータベース編集時にテーブル一覧やフィルド一覧が必要な時があります。
エクセルへのエクスポート機能も有りますが、簡単にエクセルに出力が出来るフォームを作成しましたので紹介します。

テーブルを選択出来る様にしました（2021.03.30）
説明画像は新旧混同しています。

フォーム画面

シンプルなフォーム画面で操作は非常に簡単です。

テーブル数は2000まで対応しています。

操作手順

①accessデータベース選択

「access選択」右のテキストボックスをクリックする。

ファイルダイアログが開く。

accessデータベースを選択してOKボタンをクリックする。

②テーブル名画面表示

テーブル表示ボタンをクリックする。

テーブル数とテーブル一覧が表示される。

テーブル数が180を超えると下記メッセージが表示されます。

画面表示は180ですがエクセルには2000まで表示できます。

③エクセル出力

テーブル一覧表とテーブル名横で選択したテーブルのフィルドとデータ型の一覧が表示されます。

④エクセル表示

テーブル名にaccess予約語が使用されている場合とLINKテーブルのリンク先がない場合はフィルドリストは表示されません、次のメッセージが表示されます。

⑤終了

終了ボタンをクリックすればフォームを閉じてaccessは終了します。

VBAコードの説明

①概略説明

画面表示されるテーブル名は最大180です、エクセルには2000まで出力されます。

テーブル名にACCESS予約語が使用してある場合とリンクテーブルでリンク先がない場合はエラーとなります。テーブル名は取得できますがフィルドリストは取得できません。

その場合はエラー内容が表示されます。

フィルドのデータ型で「オートナンバー型のレプリケーション ID型」と通常の「レプリケーション ID型」は区別不能でどちらもレプリケーション ID型と表示されます。

②参照設定

ADO接続でデータを読み込んでいます。

下記の参照設定をしてください。

Microsoft ADO Ext.*.* for DDL and Security
Microsoft ActiveX Data Object *.* Library
Microsoft Office **.* Object Library

宣言

Option Explicit
Dim TBNAME(2000, 2)
Dim FNAME(256, 3)
Dim AAA, BBB, I, J, ITI, S, OPFL, SFN, K

③ファイルダイアログ表示

———————————————————————–

Function FileSelect()

‘—ファイルダイアログ表示
Dim tgfn As Variant
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then
For Each tgfn In .SelectedItems
sfn = tgfn
Next
‘フォルダ、ファイル名をaccdbに代入
accdb選択 = sfn
End If
End With

End Function
————————————————————————
Private Sub accdb選択_Click()

‘—-テキストボックスを非表示にする
For I = 1 To 180
Me(“T” & I).Visible = False
Me(“O” & I).Visible = False
Me(“O” & I) = -1
Next I

accdb選択 = “”
テーブル数 = “”
‘—-ファイルダイアログ呼び出し
Call FileSelect

End Sub

④テーブル画面表示

Private Sub Form_Load()
‘フォーム最大表示
DoCmd.Maximize
End Sub

Private Sub テーブル_Click()
‘テーブル名がaccess予約語、リンクテーブルのリンク先がない場合のエラー回避
On Error Resume Next
Dim DbPath, DA, ConnStr, DB, Tbl

For I = 1 To 180
Me(“T” & I).Visible = False
Me(“O” & I).Visible = False
Me(“O” & I) = -1
Next I

‘選択ファイルをレコードセット
ConnStr = “Provider=Microsoft.ACE.OLEDB.12.0;Data Source=” & accdb選択
Set DA = CreateObject(“ADODB.Connection”)

DA.Open ConnStr
Set DB = CreateObject(“ADOX.Catalog”)
DB.ActiveConnection = DA
K = 0

‘テーブル名取り込み
For Each Tbl In DB.Tables

AAA = Tbl.Name
BBB = Tbl.Type
‘システムテーブル除外
If InStr(1, Tbl.Name, “MSys”) <> 0 Then GoTo 10
If Tbl.Type = “TABLE” Or Tbl.Type = “LINK” Then GoTo 5 Else GoTo 10

5
‘テーブル数カウント
K = K + 1
TBNAME(K, 1) = Tbl.Name
TBNAME(K, 2) = Tbl.Type
‘テーブル名表示テキストボックスを可視化
Me(“T” & K).Visible = True
Me(“O” & K).Visible = True
‘テーブル名表示
Me(“T” & K) = Tbl.Name
10
Next

テーブル数 = K
If K > 180 Then MsgBox (“テーブルは最大180までしかエクセル出力出来ません。”)

End Sub

Private Sub 選択解除_Click()
For I = 1 To 180
Me(“O” & I) = 0
Next I
End Sub

Private Sub 全選択_Click()
For I = 1 To 180
Me(“O” & I) = -1
Next I
End Sub

⑤エクセル出力

Private Sub エクセル出力_Click()
On Error Resume Next
Dim DbPath, DA, ConnStr, DB, Tbl

‘選択ファイルをレコードセット
ConnStr = “Provider=Microsoft.ACE.OLEDB.12.0;Data Source=” & accdb選択
Set DA = CreateObject(“ADODB.Connection”)

DA.Open ConnStr
Set DB = CreateObject(“ADOX.Catalog”)
DB.ActiveConnection = DA

‘エクセル使用宣言（参照設定なし）
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object

Set xlApp = CreateObject(“Excel.Application”)
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.WorKSheets(1)
xlApp.Visible = True

‘エクセルフォーマット設定
xlBook.WorKSheets(1).CELLS(1, 2) = “テーブル名”
xlBook.WorKSheets(1).CELLS(1, 3) = “備考”
xlBook.WorKSheets(1).Columns(2).HorizontalAlignment = -4131
xlBook.WorKSheets(1).CELLS(1, 2).HorizontalAlignment = -4108
xlBook.WorKSheets(1).CELLS(1, 3).HorizontalAlignment = -4108
xlBook.WorKSheets(1).Columns(4).ColumnWidth = 2

‘テーブル一覧表表示
For I = 1 To K
xlBook.WorKSheets(1).CELLS(I + 1, 1) = I
xlBook.WorKSheets(1).CELLS(I + 1, 2) = TBNAME(I, 1)
If TBNAME(I, 2) = “LINK” Then xlBook.WorKSheets(1).CELLS(I + 1, 3) = “リンクテーブル”

Next I

‘テーブル一覧表罫線
xlBook.Sheets(1).Range(xlBook.Sheets(1).CELLS(1, 1), xlBook.Sheets(1).CELLS(K + 1, 3)).Borders.LineStyle = 1
‘列幅適正
xlBook.Sheets(1).Range(xlBook.Sheets(1).Columns(1), xlBook.Sheets(1).Columns(3)).EntireColumn.AutoFit

ITI = 1
S = 1

If K > 180 Then K = 180

‘フィルド一覧表

For I = 1 To K
If Me(“o” & I) = -1 Then GoTo HYOUZI Else GoTo 100
HYOUZI:
OPFL = TBNAME(I, 1)
Dim DC As New ADODB.Recordset
DC.Open OPFL, DA, adOpenKeyset, adLockOptimistic

‘セル書式設定
xlBook.WorKSheets(1).Columns(5).ColumnWidth = 3.88
xlBook.WorKSheets(1).Columns(5).HorizontalAlignment = -4152
xlBook.WorKSheets(1).Columns(“f:g”).HorizontalAlignment = -4131
xlBook.WorKSheets(1).CELLS(1, ITI + 4).HorizontalAlignment = -4131
xlBook.WorKSheets(1).CELLS(2, ITI + 4).HorizontalAlignment = -4108
xlBook.WorKSheets(1).CELLS(2, ITI + 5).HorizontalAlignment = -4108
xlBook.WorKSheets(1).CELLS(2, ITI + 6).HorizontalAlignment = -4108
xlBook.WorKSheets(1).CELLS(1, ITI + 4).Font.Bold = True
xlBook.WorKSheets(1).CELLS(1, ITI + 4).Font.Size = 16
‘項目
xlBook.WorKSheets(1).CELLS(2, ITI + 4) = “No”
xlBook.WorKSheets(1).CELLS(2, ITI + 5) = “フィルド名”
xlBook.WorKSheets(1).CELLS(2, ITI + 6) = “データ型”

‘セル書式設定
xlBook.WorKSheets(1).Range(xlBook.WorKSheets(1).CELLS(1, ITI + 4), xlBook.WorKSheets(1).CELLS(1, ITI + 6)).MERGE
xlBook.WorKSheets(1).CELLS(1, ITI + 4).HorizontalAlignment = -4108
xlBook.WorKSheets(1).CELLS(1, ITI + 4).ShrinkToFit = True

If TBNAME(I, 2) = “LINK” Then TBNAME(I, 1) = TBNAME(I, 1) & “(LINK)”
xlBook.WorKSheets(1).CELLS(1, ITI + 4) = TBNAME(I, 1)

For J = 0 To DC.Fields.Count – 1
‘フィルド名
FNAME(J, 1) = DC.Fields(J).Name
‘データ型
FNAME(J, 2) = DC.Fields(J).Type
‘フィルドの状態
FNAME(J, 3) = DC.Fields(J).Attributes
If FNAME(J, 1) = “” Or IsNull(FNAME(J, 1)) Or Err = -2147217900 Then GoTo 20

‘データ型判別
If FNAME(J, 2) = 11 Then FNAME(J, 2) = “Yes/No型”
If FNAME(J, 2) = 17 Then FNAME(J, 2) = “バイト”
If FNAME(J, 2) = 2 Then FNAME(J, 2) = “整数型”
If FNAME(J, 2) = 3 And FNAME(J, 3) = 90 Then FNAME(J, 2) = “オートナンバー型”
If FNAME(J, 2) = 3 Then FNAME(J, 2) = “長整数型”

If FNAME(J, 2) = 72 And FNAME(J, 3) = 118 Then FNAME(J, 2) = “レプリケーション ID型”
If FNAME(J, 2) = 6 Then FNAME(J, 2) = “通貨型”
If FNAME(J, 2) = 4 Then FNAME(J, 2) = “単精度浮動小数点型”
If FNAME(J, 2) = 5 Then FNAME(J, 2) = “倍精度浮動小数点型”
If FNAME(J, 2) = 7 Then FNAME(J, 2) = “日付/時刻型”

If FNAME(J, 2) = 131 Then FNAME(J, 2) = “十進型”
If FNAME(J, 2) = 202 Then FNAME(J, 2) = “短いテキスト”
If FNAME(J, 2) = 205 Then FNAME(J, 2) = “OLEオブジェクト型”
If FNAME(J, 2) = 203 Then FNAME(J, 2) = “ハイパーリンク型”

‘ファイル名表示
xlBook.WorKSheets(1).CELLS(J + 3, ITI + 5) = FNAME(J, 1)
If FNAME(J, 1) = “” Or IsNull(FNAME(J, 1)) Or Err = -2147217900 Then GoTo 20
xlBook.WorKSheets(1).CELLS(J + 3, ITI + 4) = J
xlBook.WorKSheets(1).CELLS(J + 3, ITI + 6) = FNAME(J, 2)
GoTo 50

20
‘テーブル読み込みエラー判別

If TBNAME(I, 2) = “TABLE” Then GoTo 30
If TBNAME(I, 2) = “LINK” Then GoTo 40

30
‘テーブル名がaccess予約語の場合
xlBook.WorKSheets(1).CELLS(3, ITI + 5).Font.Color = 255
xlBook.WorKSheets(1).CELLS(3, ITI + 5) = “テーブル名”
xlBook.WorKSheets(1).CELLS(4, ITI + 5).Font.Color = 255
xlBook.WorKSheets(1).CELLS(4, ITI + 5) = “ACCESS”
xlBook.WorKSheets(1).CELLS(5, ITI + 5).Font.Color = 255
xlBook.WorKSheets(1).CELLS(5, ITI + 5) = “予約語の為”
xlBook.WorKSheets(1).CELLS(6, ITI + 5).Font.Color = 255
xlBook.WorKSheets(1).CELLS(6, ITI + 5) = “表示不可”
GoTo 50

40
‘リンクテーブルのリンク先がない場合
xlBook.WorKSheets(1).CELLS(3, ITI + 5).Font.Color = 255
xlBook.WorKSheets(1).CELLS(3, ITI + 5) = “LINK先が”
xlBook.WorKSheets(1).CELLS(4, ITI + 5).Font.Color = 255
xlBook.WorKSheets(1).CELLS(4, ITI + 5) = “有りません”

Next J
J = 0

‘罫線
xlBook.Sheets(1).Range(xlBook.Sheets(1).CELLS(1, ITI + 4), xlBook.Sheets(1).CELLS(DC.Fields.Count + 2, ITI + 6)).Borders.LineStyle = 1

DC.Close
ITI = ITI + 4

xlBook.WorKSheets(1).Columns(ITI + 3).ColumnWidth = 2

100

Next I
‘列幅適正化

xlBook.Sheets(1).Range(xlBook.Sheets(1).Columns(1), xlBook.Sheets(1).Columns(ITI + 6)).EntireColumn.AutoFit

End Sub