access

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

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

 

フォーム画面

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

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

操作手順

①accessデータベース選択

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

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

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

 

②テーブル名画面表示

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

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

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

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

③エクセル出力

エクセル出力確認のメッセージが表示されるのでOKボタンをクリックするとエクセルにテーブル一覧表とテーブル毎のフィルドとデータ型の一覧が表示される。

画面でのテーブル名確認だけでよければキャンセルをクリックする。

④エクセル表示

テーブル名に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

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

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

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
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

‘テーブル名(max2000に設定しています)
Dim TBNAME(2000, 2)
‘フィルド名
Dim FNAME(256, 3)

‘選択ファイルをレコードセット
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(“T” & K) = Tbl.Name
10
Next

テーブル数 = K
If K > 180 Then MsgBox (“テーブルの画面表示は最大180ですがエクセルには出力されます。”)

A = MsgBox(“エクセル出力しますか?”, 1)

If A <> 1 Then Exit Sub

⑤エクセル出力

‘エクセル使用宣言(参照設定なし)
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
‘フィルド一覧表

For I = 1 To K
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) = “有りません”

50

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

⑥終了

Private Sub 終了_Click()
‘フォームを閉じてaccessを終了する。
DoCmd.Quit
End Sub

ダウンロード

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

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

最後に

accessのデータベース構造の解析でテーブルをエクセルにエクスポートする時が有りますが、エクセルが見づらい事もありこのフォームを作成しました。

まだテーブルを選択してのエクセル出力等も有りますので、今後も改良して行きたいと思っています。