Accessのテーブル構造やオブジェクトの一覧をExcel経由で印刷するお手本データベース
図7-4-1 Accessのテーブル構造やオブジェクトをExcel経由で印刷するサンプルデータベース
このサンプルデータベースは、Accessのテーブル構造、オブジェクト（テーブル、クエリ、フォーム、レポート、モジュール）の一覧をExcel経由で印刷します。Excelに出力されたテーブル構造、オブジェクトの一覧は、任意の名称で保存して編集することができます。
サンプルデータベースのメニューが表示されたら、Accessのコマンドボタンをクリックします。Windowsのコモンダイアログが表示されますので、印刷するデータベースを選択します。コモンダイアログから選択したデータベース名は、メニューの最上位に表示されます。印刷対象となるデータベースを選択したら、オプショングループから対象となるオブジェクト（テーブル、クエリ、フォーム、レポート、モジュール）かテーブル構造をチェックして、Excelのボタンをクリックします。
Excel が起動されて、選択したオブジェクトまたは、テーブル構造が表示されます。例えば、Access のサンプルデータベース Northwind.mdbのテーブルを選択した場合、Excelには図7-4-2のように出力されます。Excelのワークシートの書式は、オートフォーマットまたは、既定のどちらかを選択することができます。図7-4-2は、オートフォーマットオプションを指定して出力しています。出力対象となるオブジェクトは、最終更新日の範囲を指定して絞込みすることができます。（この機能は、最終更新日を更新するタイミングが異なるため,Access 2000では使用できません。Access 97のオブジェクトを印刷するときのみ使用してください。）マウスを開始日/終了日に移動して、右ボタンをクリックすると、ポップアップカレンダーが表示されますので、マウスで日付を選択することができます。
テーブル構造を選択したときは、図7-4-3のようにデータベースに登録されている全てのテーブルの構造がシート別に出力されます。テーブル構造には、フィールド名、データ型、サイズ、説明が出力されます。フィールド名の下線は、主キーが設定されていることを意味します。データ型は、日本語と英語どちらかを選択することができます。
図7-4-2 Northwind.mdbのテーブル一覧をExcelに出力した例
図7-4-3 Northwind.mdbのテーブル構造をExcelに出力した例（テーブル構造は、シート別に作成されます）
このサンプルデータベース（CH7-4.mdb）では、以下のノウハウを習得することができます。
◆ 外部データベースを開く方法
◆ Windowsのコモンダイアログの使い方
◆ データベースのオブジェクト名（テーブル、クエリ、フォーム、レポート、モジュール）を取得する方法
◆ テーブルのフィールド名、データ型、サイズ、説明を取得する方法
◆ テーブルに設定されてるインデックスのフィールド名と主キーを取得する方法
◆ AccessからExcelを起動してデータを出力する方法
● サンプルデータベースで使用するテーブルとExcelのテンプレートを準備するには
１ Access を起動したら作業フォルダに、新規データベースCH7-4.mdbを作成します。
２ メニューから外部データベースの取り込み、インポートをクリックします。インポートのダイアログが表示されたら、CH7-4.mdbを開きます。オブジェクトのインポートのダイアログが表示されたら、テーブルタブをクリックしてすべて選択のボタンをクリックします。クエリのタブをクリックしたら、すべて選択をクリックします。最後にOKボタンをクリックしてインポートを完了させます。
表7-4-1 tblTableの構造
|
テーブル名 |
説 明 |
作成日 |
最終更新日 |
||
|
tblTable |
テーブル名を格納します |
|
|
||
|
No |
フィールド名 |
データ型 |
サイズ |
説 明 |
|
|
1 |
TableName |
テキスト型 |
50 |
主キー設定 |
|
|
2 |
DateCreated |
日付/時刻型 |
8 |
|
|
|
3 |
DateUpdated |
日付/時刻型 |
8 |
|
|
|
4 |
Description |
テキスト型 |
255 |
|
|
表7-4-2 tblTableDetailsの構造
|
テーブル名 |
説 明 |
作成日 |
最終更新日 |
||
|
tblTableDetails |
フィールド情報を格納します |
|
|
||
|
No |
フィールド名 |
データ型 |
サイズ |
説 明 |
|
|
1 |
TableName |
テキスト型 |
50 |
主キー設定 |
|
|
2 |
FieldName |
テキスト型 |
50 |
主キー設定 |
|
|
3 |
DataType |
テキスト型 |
50 |
|
|
|
4 |
Size |
長整数型 |
4 |
|
|
|
5 |
PrimaryKey |
Yes/No型 |
1 |
|
|
|
6 |
Description |
テキスト型 |
255 |
|
|
|
7 |
OrdinalPosition |
長整数型 |
4 |
|
|
表7-4-3 tblWorkの構造
|
テーブル名 |
説 明 |
作成日 |
最終更新日 |
||
|
tblWork |
オブジェクト名を格納します |
|
|
||
|
No |
フィールド名 |
データ型 |
サイズ |
説 明 |
|
|
1 |
Name |
テキスト型 |
255 |
主キー設定 |
|
|
2 |
DateCreate |
日付/時刻型 |
8 |
|
|
|
3 |
DateUpdate |
日付/時刻型 |
8 |
|
|
|
4 |
Description |
テキスト型 |
255 |
|
|
３ テーブルとクエリをインポートしたらAccess を終了します。
４ フォルダ(CH7-4)から、ExcelのテンプレートAccessObjects.xls、TableStructure.xlsを作業フォルダにコピーします。AccessObjects.xlsは、Accessのオブジェクト（テーブル、クエリ、フォーム、レポート、モジュール）をExcelに出力するときの雛型として使用します。TableStructure.xlsは、Accessのテーブル構造をExcelに出力するときの雛型として使用します。
● Accessのテーブル構造、オブジェクト一覧をExcelに出力するフォームを作成するには
１ Access を起動したら、作業フォルダに作成したCH7-4.mdbを開きます。
２ データベースウィンドウからフォーム
をクリックしたら、一覧からデザインビューでフォームを作成するをダブルクリックします。フォームのデザインビューが表示されたら、メニューからツールボックスのアイコン
をクリックします。
３ ツールボックスからテキストボックスのアイコン
をクリックしたら、フォーム詳細の上位に配置します。このテキストボックスには、データベースのファイル名を表示します。
４ ツールボックスからオプショングループのアイコン
をクリックして、６個（テーブル、クエリ、フォーム、レポート、モジュール、テーブル構造）のチェックボックスを作成します。これらのチェックボックスは、Excelに出力するオブジェクトを選択するときに使用します。
５ ツールボックスからチェックボックスのアイコン
をクリックしたら、オプショングループの下に、オートフォーマットと日本語の２個のチェックボックスを作成します。オートフォーマットは、Excel のオートフォーマットを有効にします。日本語のチェックボックスは、テーブル構造をExcelに出力するとき、フィールドのデータ型を日本語で表示します。（データ型の既定値は英語です。）ツールボックスから四角形のアイコン
をクリックしたら、２個のチェックボックスを囲みます。
６ ツールボックスからラベルのアイコン
をクリックしたら、チェックボックスの下に配置して、標題に“最終更新日の範囲を指定すると、改訂版で修正したオブジェクトのみ出力することができます。”を入力します。ツールボックスからテキストボックスのアイコンをクリックしたら、ラベルの下に開始日と終了日のテキストボックスを作成します。ツールボックからラベルのアイコンをクリックしたら、テキストボックスの間に配置して、標題に“～”を入力します。ツールボックスから、四角形のアイコンをクリックしたら、ラベルとテキストボックスを囲みます。
７ ツールボックスからコマンドボタンのアイコン
をクリックしたら、オプショングループの右側に３個（上からExcel、Access、閉じる）のコマンドボタンを作成します。
８ フォームに作成したコントロールのプロパティを表7-4-4のように設定します。
表7-4-4 フォームに作成したコントロールのプロパティ
|
コントロールの種類 |
プロパティ |
値 |
|||||||||||||
|
テキストボックス１ |
名前 |
txtDBName |
|||||||||||||
|
背景色 |
16777088 |
||||||||||||||
|
オプショングループ |
名前 |
grpObject |
|||||||||||||
|
|
チェックボックス：
|
||||||||||||||
|
チェックボックス１ （ｵｰﾄﾌｫｰﾏｯﾄ） |
名前 |
chkAutoFormat |
|||||||||||||
|
既定値 |
True |
||||||||||||||
|
チェックボックス２ （日本語） |
名前 |
chkJP |
|||||||||||||
|
既定値 |
False |
||||||||||||||
|
四角形１ |
立体表示 |
くぼみ |
|||||||||||||
|
ラベル１ |
標題 |
最終更新日の範囲を指定すると、改訂版で修正したオブジェクトのみ出力することができます。 |
|||||||||||||
|
テキストボックス２ （開始日） |
名前 |
txtFromDate |
|||||||||||||
|
書式 |
yyyy/mm/dd |
||||||||||||||
|
ラベル２ |
標題 |
～ |
|||||||||||||
|
テキストボックス３ （終了日） |
名前 |
txtToDate |
|||||||||||||
|
書式 |
yyyy/mm/dd |
||||||||||||||
|
四角形２ |
立体表示 |
くぼみ |
|||||||||||||
|
コマンドボタン１ （Excel） |
名前 |
cmdPrint |
|||||||||||||
|
ピクチャ |
ビットマップ |
||||||||||||||
|
コマンドボタン２ （Access） |
名前 |
cmdOpenMDB |
|||||||||||||
|
ピクチャ |
ビットマップ |
||||||||||||||
|
コマンドボタン３ （閉じる） |
名前 |
cmdExit |
|||||||||||||
|
ピクチャ |
ビットマップ |
||||||||||||||
|
フォーム |
ショートカットメニュー |
いいえ |
図7-4-4 Accessのオブジェクトとテーブル構造を表示するフォームのレイアウト
９ メニューからコードのアイコン
をクリックして、フォームモジュールを表示させます。CH7-4.mdbを開いて、frmMyDoc2Xlsのフォームモジュールをコピーして貼り付けます。フォームモジュールのソースコードは、リスト7-4-1を参照してください。
CH7-4.mdbからフォームfrmCalendarClassをコピーします。frmCalendarClassは、ポップアップカレンダーを表示するフォームで、3-3章で解説しています。また、標準モジュールbasExportAccessObjects, basExportTableStructure, basMyDoc, basMyLib, basWindowsCommonDialog、クラスモジュールclsCalendarをコピーします。これらのモジュールは、フォームモジュールから参照します。これらのモジュールは、Microsoft DAO 3.6 Object Library, Microsoft Excel 9.0 Object Library, Microsoft ADO Ext 2.x for DDL and Securityのライブラリを参照しますので、ＶＢＥのツールメニューから参照設定をクリックして登録してください。
１０ フォームをビューモードに切り替えたら、Accessのコマンドボタンをクリックして、対象となるデータベースを選択します。データベースを選択した、Accessのオブジェクトまたはテーブル構造をチェックして、Excelのボタンをクリックします。Excel が起動されて、選択したオブジェクトまたは、テーブル構造がExcel上に出力されて表示されます。Excelのデータを確認したら、Excelのファイルに任意の名称を付けて保存して終了させます。Excel を終了させると、Access にフォーカスが移動して、“レポートをカスタマイズして印刷してください！・・・・”のメッセージが表示されていますので、OKボタンをクリックして閉じます。
１１ フォームをfrmMyDoc2Xlsの名称で保存したらAccess を終了させます。
Form_Load()イベント処理
このイベントは、フォームが開かれてデータをロードするときに発生します。このイベントでは、カレンダーのクラスモジュールのインスタンスを生成して、日付のテキストボックスのコントロールを登録します。クラスモジュールのRegisterControlsメソッドで、開始日、終了日のテキストボックスのコントロールを登録すると、マウスの右ボタンをクリックしたとき、イベントが発生して自動的にポップアップカレンダーが表示されます。ポップアップカレンダーの詳細については、３－３章を参照してください。
Private mclsCal As clsCalendar
Set mclsCal = New
clsCalendar
mclsCal.RegisterControls Me.txtFromDate, Me.txtToDate
grpObject_AfterUpdate()
このイベントは、オプショングループからアイテムをチェックしたときに発生します。このイベントでは、テーブル構造をチェックしたとき、開始日/終了日のテキストボックスの使用可能(Enabled)プロパティをFalseに設定します。テーブル構造以外をチェックしたときは、開始日/終了日の使用可能（Enabled）プロパティをTrueに設定します。
If Me.grpObject = 9 Then
Me.txtFromDate.Enabled = False
Me.txtToDate.Enabled = False
Else
Me.txtFromDate.Enabled = True
Me.txtToDate.Enabled = True
End If
cmdPrint_Click()
このイベントは、フォームからExcelのコマンドボタンをクリックしたときに発生します。このイベントでは、オプショングループで選択したAccessのオブジェクトまたは、テーブル構造をExcelに出力します。Select Case Me.grpObject…End Selectでは、Accessのデータベースからオブジェクト名を取得するためのSQLを作成します。最終更新日を指定したときは、SQLのWHERE句に最終更新日のフィルタ条件を追加します。
strWhere = " WHERE
MSysObjects.DateUpdate Between #" _
& Me![txtFromDate]
& "# And #" & Me![txtToDate] & "# AND "
Accessのオブジェクト名を取得するための、SQLコマンドを作成したらサブプロシージャMyDocCreateWorkまたは、MyDocStructureを呼び出して作業テーブルを作成します。
MyDocCreateWorkは、Accessのオブジェクト名を取得して作業テーブルtblWorkに格納します。MyDocStructureは、Accessのテーブル名とテーブルのフィールド情報（フィールド名、データ型、サイズ、説明）を取得して、作業テーブルtblTable, tblTableDetailsに格納します。
作業テーブルを作成したら、サブプロシージャExportAccessObjectまたは、ExportTableStructureを呼び出して作業テーブルの内容をExcel のワークシート上に出力します。
表7-4-5 データベースからAccessのオブジェクト名を取得するSQL
|
オブジェクト |
SQL |
|
テーブル |
SELECT
MSysObjects.Name, MSysObjects.DateUpdate, MSysObjects.DateCreate FROM MSysObjects WHERE
(((MSysObjects.Type)=1 Or (MSysObjects.Type)=6) AND ((Left([name],4))<>"USys"
And (Left([name],4))<>"MSys") AND ((Left([name],1))<>"~")) ORDER BY
MSysObjects.Name; |
|
クエリ |
SELECT
MSysObjects.Name, MSysObjects.DateCreate, MSysObjects.DateUpdate FROM MSysObjects WHERE
(((MSysObjects.Type)=5) AND ((Left([name],4))<>"USys" And
(Left([name],4))<>"~sq_")) ORDER BY
MSysObjects.Name; |
|
フォーム |
SELECT
MSysObjects.Name, MSysObjects.DateCreate, MSysObjects.DateUpdate FROM MSysObjects WHERE
(((MSysObjects.Type)=-32768) AND ((Left([name],4))<>"USys")) ORDER BY
MSysObjects.Name; |
|
レポート |
SELECT
MSysObjects.Name, MSysObjects.DateUpdate, MSysObjects.DateCreate FROM MSysObjects WHERE
(((MSysObjects.Type)=-32764) AND ((Left([Name],4))<>"YSys")) ORDER BY
MSysObjects.Name; |
|
モジュール |
SELECT
MSysObjects.Name, MSysObjects.DateUpdate, MSysObjects.DateCreate FROM MSysObjects WHERE
(((MSysObjects.Type)=-32761) AND ((Left([Name],4))<>"USys")) ORDER BY
MSysObjects.Name; |
cmdOpenMDB_Click()
このイベントは、フォームからAccessのコマンドボタンをクリックしたときに発生します。このイベントでは、MyDocInit()関数を使用して対象となるAccessのデータベース名を取得します。MyDocInit()からは、OpenFile_FS()を使用して、Windowsのコモンダイアログから任意のデータベース名を選択することができます。データベースのフルパス名を取得したら、DBEngine.Workspaces(0).OpenDatabase(gstrMdbPath)で開いて、広域メモリ変数gdbにオブジェクトポインタを設定します。Dir()で、データベース名を取得したら、MyDocInit()の戻り値として返します。
Function MyDocInit()
As String
Dim intPos As Integer
Set gmydb = CurrentDb
gstrMdbPath =
OpenFile_FS(CurrentProject.Path, _
"MyDoc2Xlsで印刷するﾃﾞｰﾀﾍﾞｰｽﾌｧｲﾙを選択してください")
If Len(gstrMdbPath) = 0 Then
MyDocInit = vbNullString
Exit Function
End If
gstrMdbName = Dir(gstrMdbPath)
Set gdb =
DBEngine.Workspaces(0).OpenDatabase(gstrMdbPath)
MyDocInit = gstrMdbName
End Function
cmdExit_Click()イベント処理
このイベントは、フォームから閉じるのボタンをクリックしたときに発生します。このイベントでは、DoCmdのCloseメソッドでフォームを閉じます。
リスト7-4-1 frmMyDoc2Xlsのフォームモジュール
|
Option Compare Database Option Explicit Private mclsCal As clsCalendar Private Sub Form_Load() Set mclsCal = New clsCalendar mclsCal.RegisterControls Me.txtFromDate, Me.txtToDate End Sub Private Sub Form_Open(Cancel As Integer) Call SetAppTitle_FS("MyDoc2Xls (C) " & Year(Date) & " by Akio Kasai") End Sub Private Sub cmdPrint_Click() On Error GoTo Err_cmdPrint_Click
Dim strSQL As String Dim strWhere As String Dim strOrder As String
Dim strLeftHeader As String Dim strCenterHeader As String Dim strRightHeader As String
strSQL = "SELECT MSysObjects.Name,” _ & “ MSysObjects.DateUpdate, MSysObjects.DateCreate" _ & " FROM MSysObjects" If (IsNull(Me!txtFromDate) Or Me!txtFromDate = "") And _ (IsNull(Me!txtToDate) Or Me!txtToDate = "") Then strWhere = " WHERE " Else strWhere = " WHERE MSysObjects.DateUpdate Between #" _ & Me![txtFromDate] & "# And #" & Me![txtToDate] & "# AND " End If strOrder = " ORDER BY MSysObjects.Name;" Select Case grpObject Case acTable strLeftHeader = "テーブルリスト" strWhere = strWhere _ & " (MSysObjects.Type=1 OR MSysObjects.Type=4 " _ & " OR MSysObjects.Type=6)" _ & " AND Left(MSysObjects.Name,4) <> 'USys' " _ & " AND Left(MSysObjects.Name,4) <> 'MSys' " _ & " AND Left(MSysObjects.Name,1) <> '~' " strSQL = strSQL & strWhere & strOrder Call MyDocCreateWork(strSQL, acTable) Case acQuery strLeftHeader = "クエリーリスト" strWhere = strWhere _ & " MSysObjects.Type=5 " _ & " AND Left(MSysObjects.Name,4) <> 'USys' " _ & " AND Left(MSysObjects.Name,4) <> 'MSys' " _ & " AND Left(MSysObjects.Name,1) <> '~' " strSQL = strSQL & strWhere & strOrder Call MyDocCreateWork(strSQL, acQuery) Case acForm strLeftHeader = "フォームリスト" strWhere = strWhere _ & " MSysObjects.Type=-32768 " _ & " AND Left(MSysObjects.Name,4) <> 'USys' " _ & " AND Left(MSysObjects.Name,4) <> 'MSys' " _ & " AND Left(MSysObjects.Name,1) <> '~' " strSQL = strSQL & strWhere & strOrder Call MyDocCreateWork(strSQL, acForm) Case acReport strLeftHeader = "レポートリスト" strWhere = strWhere _ & " MSysObjects.Type=-32764 " _ & " AND Left(MSysObjects.Name,4) <> 'USys' " _ & " AND Left(MSysObjects.Name,4) <> 'MSys' " _ & " AND Left(MSysObjects.Name,1) <> '~' " strSQL = strSQL & strWhere & strOrder Call MyDocCreateWork(strSQL, acReport) Case acModule strLeftHeader = "モジュールリスト" strWhere = strWhere _ & " MSysObjects.Type=-32761 " _ & " AND Left(MSysObjects.Name,4) <> 'USys' " _ & " AND Left(MSysObjects.Name,4) <> 'MSys' " _ & " AND Left(MSysObjects.Name,1) <> '~' " strSQL = strSQL & strWhere & strOrder Call MyDocCreateWork(strSQL, acModule) Case 9 ' Table Structure strLeftHeader = "テーブル構造リスト" Call MyDocStructure(Me) End Select
If Len(gstrMdbName) = 0 Then Exit Sub End If
If IsNull(Me!txtDBName) Or Me!txtDBName = "" Then txtDBName = gstrMdbName End If
If Len(Nz(txtFromDate)) = 0 And Len(Nz(txtToDate)) = 0 Then strCenterHeader = "" Else strCenterHeader = "【最終更新日：" & Format(txtFromDate, "yyyy/mm/dd") _ & " ～ " & Format(txtToDate, "yyyy/mm/dd") & "】" End If
strRightHeader = gstrMdbName
If grpObject = 9 Then Call ExportTableStructure(chkAutoFormat, "", "", strRightHeader) Else Call ExportAccessObject( _ chkAutoFormat, strLeftHeader, strCenterHeader, strRightHeader) End If
Exit_cmdPrint_Click: Exit Sub Err_cmdPrint_Click: MsgBox Err.Description Resume Exit_cmdPrint_Click End Sub Private Sub cmdExit_Click() DoCmd.Close 'DoCmd.Quit End Sub Private Sub cmdOpenMDB_Click() Me.txtDBName = MyDocInit() End Sub Private Sub grpObject_AfterUpdate() If Me.grpObject = 9 Then Me.txtFromDate.Enabled = False Me.txtToDate.Enabled = False Else Me.txtFromDate.Enabled = True Me.txtToDate.Enabled = True End If End Sub |
MyDocCreateWork()
このプロシージャは、Accessのオブジェクト名を取得して作業テーブルtblWorkに追加します。このプロシージャには、引数としてオブジェクト名を取得するSQLとオブジェクトタイプを指定します。DatabaseオブジェクトのExecuteメソッドで、削除用のSQLコマンドを指定して作業テーブルの全レコードを削除して空にします。
gmydb.Execute "DELETE * FROM
tblWork;"
DatabaseオブジェクトのOpenRecordsetメソッドで、引数で指定されたSQLと作業テーブルtblWorkを開きます。
Set rsList = gdb.OpenRecordset(strSQL)
Set rsWork = gmydb.OpenRecordset("tblWork")
Do While Not .EOF…Loopでは、Accessのオブジェクト名、作成日､更新日、説明を取得して作業テーブルに追加します。RecordsetオブジェクトのAddNewメソッドで、新規レコードを追加したら、フィールド（名称、作成日、最終更新日、説明）に値を設定してUpdateメソッドで更新します。フィールドの説明(Description)は、オブジェクトの種類により取得方法が異なります。
rsWork.AddNew
rsWork("Name") =
!Name
rsWork("DateCreate") = !DateCreate
rsWork("DateUpdate") = !DateUpdate
rsWork("Description") = strDesc
rsWork.Update
全てのオブジェクトを処理したら、レコードセットを閉じて終了します。
リスト7-4-2 MyDocCreateWorkのソースコード
|
Sub MyDocCreateWork(strSQL As String, intType As Integer) Dim tdf As DAO.TableDef Dim qdf As DAO.QueryDef Dim ctr As DAO.Container Dim doc As DAO.Document Dim rsList As DAO.Recordset Dim rsWork As DAO.Recordset Dim strDesc As String
If Len(gstrMdbPath) = 0 Then Call MyDocInit If Len(gstrMdbPath) = 0 Then Exit Sub End If End If
gmydb.Execute "DELETE * FROM tblWork;" Set rsList = gdb.OpenRecordset(strSQL) Set rsWork = gmydb.OpenRecordset("tblWork") If rsList.EOF Then Exit Sub End If
With rsList .MoveFirst Do While Not .EOF rsWork.AddNew rsWork("Name") = !Name rsWork("DateCreate") = !DateCreate rsWork("DateUpdate") = !DateUpdate strDesc = "" On Error Resume Next If intType = acTable Then Set tdf = gdb.TableDefs(!Name) With tdf If .Connect <> "" Then strDesc = .Connect Else strDesc = .Properties("Description") End If End With ElseIf intType = acQuery Then Set qdf = gdb.QueryDefs(!Name) strDesc = qdf.Properties("Description") Else If intType = acForm Then Set ctr = gdb.Containers("Forms") ElseIf intType = acReport Then Set ctr = gdb.Containers("Reports") ElseIf intType = acModule Then Set ctr = gdb.Containers("Modules") End If Set doc = ctr.Documents(!Name) strDesc = doc.Properties("Description") End If On Error GoTo 0 rsWork("Description") = strDesc rsWork.Update .MoveNext Loop End With rsList.Close rsWork.Close Set rsList = Nothing Set rsWork = Nothing
End Sub |
MyDocStructure()
このサブプロシージャは、データベースに登録されている全てのテーブルのフィールド情報を取得して作業テーブルに格納します。SQLのDELETEコマンドで、tblTableとtblTableDetailsテーブルの全てのレコードを削除して空にします。
gmydb.Execute "DELETE * FROM tblTable;"
gmydb.Execute "DELETE * FROM
tblTableDetails;"
For cntTbls = 0 To gdb.TableDefs.Count – 1…Loopでは、データベースに登録されている全てのテーブルを処理します。Set curTbl = gdb.TableDefs(cntTbls)で、カレントテーブルをオブジェクト変数に設定したら、システムオブジェクトまたは隠しオブジェクトかどうか調べます。システムまたは、隠しオブジェクト以外なら、AddNewメソッドでtblTableにレコードを追加します。フィールドに値を設定したら、Updateメソッドで更新します。テーブルがリンク(Connect)されているときは、フィールド説明(Description)にリンク先情報を設定します。
rsTables.AddNew
rsTables("TableName") = curTbl.Name
rsTables("DateCreated") = curTbl.DateCreated
rsTables("DateUpdated") = curTbl.LastUpdated
If curTbl.Connect
<> "" Then
rsTables("Description") = curTbl.Connect
Else
rsTables("Description") = curTbl.Properties("Description")
End If
rsTables.Update
For cntFlds = 0 To curTbl.Fields.Count – 1…Loopでは、テーブルの全てのフィールドを処理します。Set curFld = curTbl.Fields(cntFlds)で、フィールドのオブジェクトをメモリ変数に設定したら、AddNewメソッドでtblTableDetailsにレコードを追加します。フィールドに値を設定したら、Updateメソッドで更新します。For cntKey = 0 To curTbl.Indexes.Count – 1…Loopでは、テーブルの全てのインデックスを処理します。For cntIdx = 0 To curIdx.Fields.Count – 1…Loopでは、全てのインデックスフィールドを処理します。インデックスフィールドが主キーのときは、PrimaryKeyにTrueを設定します。
rsTblDetail.AddNew
rsTblDetail("TableName") = curTbl.Name
rsTblDetail("FieldName") = curFld.Name
rsTblDetail("DataType") = "データ型"
rsTblDetail("Size") = curFld.Size
rsTblDetail("OrdinalPosition") = curFld.OrdinalPosition
rsTblDetail("Description") = curFld.Properties("Description")
If (curFld.Name = curIdxFld.Name) And (curIdx.Primary = True) Then
rsTblDetail("PrimaryKey") = True
End If
rsTblDetail.Update
データベースに登録されている全てのテーブルを処理したら、レコードセットを閉じて終了します。
リスト7-4-3 MyDocStructureのソースコード
|
Sub MyDocStructure(frm As Form)
Dim rsTables As DAO.Recordset Dim rsTblDetail As DAO.Recordset Dim curTbl As DAO.TableDef Dim curFld As DAO.Field, curIdxFld As DAO.Field Dim curIdx As DAO.Index Dim cntTbls As Integer, cntFlds As Integer, cntKey As Integer Dim cntIdx As Integer Dim strMdbPath As String Const NO_DESC_FOUND = 3270 On Error GoTo MyDocStructure_err
DoCmd.Hourglass (True) gmydb.Execute "DELETE * FROM tblTable;" gmydb.Execute "DELETE * FROM tblTableDetails;"
Set rsTables = gmydb.OpenRecordset("tblTable") Set rsTblDetail = gmydb.OpenRecordset("tblTableDetails")
' ﾃﾞｰﾀﾍﾞｰｽ内の全てのﾃｰﾌﾞﾙを処理します For cntTbls = 0 To gdb.TableDefs.Count - 1 Set curTbl = gdb.TableDefs(cntTbls) ' ｼｽﾃﾑｵﾌﾞｼﾞｪｸﾄ、隠しｵﾌﾞｼﾞｪｸﾄならｽｷｯﾌﾟします If (curTbl.Attributes And dbSystemObject) = False _ And (curTbl.Attributes And dbHiddenObject) = False Then rsTables.AddNew rsTables("TableName") = curTbl.Name rsTables("DateCreated") = curTbl.DateCreated rsTables("DateUpdated") = curTbl.LastUpdated If curTbl.Connect <> "" Then rsTables("Description") = curTbl.Connect Else rsTables("Description") = curTbl.Properties("Description") End If rsTables.Update ' ﾃｰﾌﾞﾙの全ﾌｨｰﾙﾄﾞを処理します For cntFlds = 0 To curTbl.Fields.Count - 1 Set curFld = curTbl.Fields(cntFlds) ' ｼｽﾃﾑ用のﾌｨｰﾙﾄﾞをｽｷｯﾌﾟします If Left(curFld.Name, 2) <> "s_" Then rsTblDetail.AddNew rsTblDetail("TableName") = curTbl.Name rsTblDetail("FieldName") = curFld.Name If frm.chkJP Then Select Case curFld.Type Case dbText rsTblDetail("DataType") = "テキスト型" Case dbDouble rsTblDetail("DataType") = "倍精度浮動小数点型" Case dbInteger rsTblDetail("DataType") = "整数型" Case dbBoolean rsTblDetail("DataType") = "Yes/No型" Case dbDate rsTblDetail("DataType") = "日付/時刻型" Case dbMemo rsTblDetail("DataType") = "メモ型" Case dbLong If curFld.Attributes And dbAutoIncrField Then rsTblDetail("DataType") = "オートナンバー型" Else rsTblDetail("DataType") = "長整数型" End If Case dbCurrency rsTblDetail("DataType") = "通貨型" Case dbSingle rsTblDetail("DataType") = "単精度浮動小数点型" Case dbLongBinary rsTblDetail("DataType") = "OLEオブジェクト型" Case dbByte rsTblDetail("DataType") = "バイト型" Case Else rsTblDetail("DataType") = "その他" End Select Else Select Case curFld.Type Case dbText rsTblDetail("DataType") = "Text" Case dbDouble rsTblDetail("DataType") = "Double" Case dbInteger rsTblDetail("DataType") = "Integer" Case dbBoolean rsTblDetail("DataType") = "Yes/No" Case dbDate rsTblDetail("DataType") = "Date/Time" Case dbMemo rsTblDetail("DataType") = "Memo" Case dbLong If curFld.Attributes And dbAutoIncrField Then rsTblDetail("DataType") = "Autonumber" Else rsTblDetail("DataType") = "Long" End If Case dbCurrency rsTblDetail("DataType") = "Currency" Case dbSingle rsTblDetail("DataType") = "Single" Case dbLongBinary rsTblDetail("DataType") = "OLE Object" Case dbByte rsTblDetail("DataType") = "Byte" Case Else rsTblDetail("DataType") = "Other" End Select End If rsTblDetail("Size") = curFld.Size rsTblDetail("OrdinalPosition") = curFld.OrdinalPosition rsTblDetail("Description") = curFld.Properties("Description") ' ﾃｰﾌﾞﾙの全てのｲﾝﾃﾞｯｸｽを処理します For cntKey = 0 To curTbl.Indexes.Count - 1 Set curIdx = curTbl.Indexes(cntKey) ' ｲﾝﾃﾞｯｸｽの全てのﾌｨｰﾙﾄﾞを処理します For cntIdx = 0 To curIdx.Fields.Count - 1 Set curIdxFld = curIdx.Fields(cntIdx) ' 主ｷｰか調べます If (curFld.Name = curIdxFld.Name) _ And (curIdx.Primary = True) Then rsTblDetail("PrimaryKey") = True End If Next cntIdx Next cntKey rsTblDetail.Update End If Next cntFlds End If Next cntTbls
rsTables.Close rsTblDetail.Close Set rsTables = Nothing Set rsTblDetail = Nothing
DoCmd.Hourglass (False) MyDocStructure_exit: Exit Sub
MyDocStructure_err: ' ﾃｰﾌﾞﾙの説明がﾌﾞﾗﾝｸからｴﾗｰを無視して処理を続行します If Err = 3270 Or Err = 3265 Or Err = 3163 Then Resume Next End If MsgBox "In MyDocStructure Error " & Err & " is: " & Error Resume MyDocStructure_exit End Sub |
ExportAccessObject()
このサブプロシージャは、作業テーブルtblWorkに格納されているAccessのオブジェクトをExcel に出力します。New Excel.Applicationで、Excel 2000のインスタンスを生成したら、オブジェクト変数xlAppにポインタを設定します。WorkbooksコレクションオブジェクトのOpenメソッドで、Excelのテンプレートファイル(AccessObjcts.xls)を開きます。DatabaseオブジェクトのOpenRecordsetメソッドで、tblWorkを開いたらDo Until rs.EOF…Loopで作業テーブルの内容をワークシートに出力します。レポートの見出しは、セルの位置が固定なため、Rangeプロパティでセルのアドレスを直接指定して設定します。
.Range("A1").Value = "No"
.Range("B1").Value = "名 称"
.Range("C1").Value = "説 明"
.Range("D1").Value = "作成日"
.Range("E1").Value = "最終更新日"
Accessのオブジェクトの名称(Name)、説明(Description)、作成日(DateCreate)、最終更新日(DateUpdate)などのデータは、Cellsプロパティを使用して設定します。
.Cells(intRow,
1).Value = intRow - 1
.Cells(intRow,
2).Value = rs!Name
.Cells(intRow,
3).Value = rs!Description
.Cells(intRow,
4).Value = rs!DateCreate
.Cells(intRow,
5).Value = rs!DateUpdate
SelectionオブジェクトのDeleteメソッドで不要なセルを削除したら、表に罫線を引きます。罫線は、オートフォーマットまたは、格子型を選択することができます。ActiveSheetオブジェクトのPageSetupプロパティでページの見出し、ヘッダー、フッター、用紙サイズ、印刷の向きなどの情報を設定したら、Excelの可視(Visible)プロパティをTrueに設定してExcel を表示させます。
最後に、SelectionオブジェクトのPrintOutメソッドでプレビュー印刷したら、MsgBoxでメッセージを表示してExcel にフォーカスを移動させます。MsgBoxからOKボタンがクリックされたら、Excel 2000を終了(Quit)させます。
リスト7-4-4 Sub ExportAccessObjectのソースコード
|
Option Compare Database Option Explicit Private Const conFilename As String = "AccessObjects.xls" Public Sub ExportAccessObject(fAutoFormat As Boolean, _ Optional varLeftHeader As Variant, _ Optional varCenterHeader As Variant, _ Optional varRightHeader As Variant, _ Optional varLeftFooter As Variant, _ Optional varCenterFooter As Variant = "&P / &N", _ Optional varRightFooter As Variant) ' ' AccessのObjects(Table, Query, Form, Report, Module)をExcelに出力します。 ' Excelに出力するとき、テンプレート(AccessObjects.xls)を読み込み専用で開いて ' レポートの雛型とします。 ' ' Dim db As DAO.Database Dim rs As DAO.Recordset Dim frm As Form Dim strSQL As String
Dim xlApp As Excel.Application Dim xlWrkbk As Excel.Workbook Dim xlWrksh As Excel.Worksheet Dim xlRange As Excel.Range
Dim strFilename As String Dim strCell As String Dim intRow As Integer Dim intCol As Integer
On Error GoTo Err_ExportAccessObject
DoCmd.Hourglass (True)
' テンプレートのパス名を取得します strFilename = CurrentProject.Path & "\" & conFilename
' ' Excel 2000を起動してテンプレート(AccessObjects.xls)を読み込みモードで開きます ' Set xlApp = New Excel.Application Set xlWrkbk = xlApp.Workbooks.Open(FileName:=strFilename, ReadOnly:=True)
' ' Access Objectが格納されているテーブル(tblWork)を開きます '
strSQL = "SELECT Name, DateCreate, DateUpdate, Description" _ & " FROM tblWork" _ & " ORDER BY Name;" Set rs = gmydb.OpenRecordset(strSQL, dbOpenSnapshot) With rs If .EOF Or .BOF Then MsgBox "該当するオブジェクトはありません！", vbExclamation GoTo Exit_ExportAccessObject End If End With
' -------------------------------------------- ' Access Objectsをｼｰﾄ上に作成する ' -------------------------------------------- Set xlWrksh = xlWrkbk.Worksheets(1) With xlWrksh .Range("A1").Value = "No" .Range("B1").Value = "名 称" .Range("C1").Value = "説 明" .Range("D1").Value = "作成日" .Range("E1").Value = "最終更新日"
intRow = 1 rs.MoveFirst Do Until rs.EOF intRow = intRow + 1 .Cells(intRow, 1).Value = intRow - 1 .Cells(intRow, 2).Value = rs!Name .Cells(intRow, 3).Value = rs!Description .Cells(intRow, 4).Value = rs!DateCreate .Cells(intRow, 5).Value = rs!DateUpdate rs.MoveNext Loop End With
With xlApp ' 不要な行を削除する .Rows(CStr(intRow + 1) & ":500").Select ' Rows(5:500).Select .Selection.Delete Shift:=xlUp
If fAutoFormat Then ' ｵｰﾄﾌｫｰﾏｯﾄ1,3を適用して書式設定 .ActiveSheet.Range("A1", "E" & CStr(intRow)).Select ' A1:E99 .Selection.AutoFormat _ Format:=xlRangeAutoFormatLocalFormat1, _ Number:=False, _ Font:=True, Alignment:=True, Border:=True, _ Pattern:=True, Width:=True
.Selection.AutoFormat _ Format:=xlRangeAutoFormatLocalFormat3, Number:=False, _ Font:=True, Alignment:=True, Border:=True, _ Pattern:=True, Width:=True Else ' 行見出しに網掛けする .Range("A1:E1").Select With .Selection.Interior .ColorIndex = 34 .Pattern = xlSolid End With
' 罫線（格子型）を引く .ActiveSheet.Range("A1", "E" & CStr(intRow)).Select ' A1:E99 .Selection.AutoFormat _ Format:=xlRangeAutoFormatLocalFormat3, Number:=False, _ Font:=False, Alignment:=False, Border:=True, _ Pattern:=False, Width:=False End If
' ページのタイトルを設定する With .ActiveSheet.PageSetup .PrintTitleRows = "$1:$1" ' .PrintTitleColumns = "$A:$A" End With
' ページヘッダー/フッターを設定 With .ActiveSheet.PageSetup .LeftHeader = varLeftHeader .CenterHeader = varCenterHeader .RightHeader = varRightHeader .LeftFooter = varLeftFooter .CenterFooter = varCenterFooter .RightFooter = varRightFooter End With
' 用紙サイズ(A4)と印刷の向き（縦）設定 With .ActiveSheet.PageSetup .Orientation = xlPortrait ' xlLandscape .PaperSize = xlPaperA4 End With
' Excelを表示状態にして印刷前にカスタマイズ可能とする .Sheets(1).Select .Visible = True
' プレビュー印刷 .Selection.PrintOut Preview:=True, Collate:=True
End With
MsgBox "レポートをカスタマイズして印刷してください！" & vbCrLf _ & vbCrLf & "後で印刷するときは、別名で一旦保存してください！", _ vbInformation, "MyDoc2Xls"
Exit_ExportAccessObject: On Error Resume Next DoCmd.Hourglass (False)
If Not xlApp Is Nothing Then With xlWrkbk .Close SaveChanges:=False End With With xlApp .Quit End With Set xlWrksh = Nothing Set xlWrkbk = Nothing Set xlApp = Nothing End If
If Not rs Is Nothing Then rs.Close Set rs = Nothing End If Exit Sub
Err_ExportAccessObject: MsgBox Err.Number & " " & Err.Description Resume Exit_ExportAccessObject End Sub |
ExportTableStructure()
このサブプロシージャは、作業テーブルtblTable, tblTableDetailsに格納されているテーブル名とテーブルのフィールド情報をExcel 2000に出力します。尚、テーブル構造は、シート別に作成します。New Excel.Applicationで、Excel 2000のインスタンスを生成したら、オブジェクト変数にポインタを設定します。WorkbooksコレクションオブジェクトのOpenメソッドでテンプレートファイル(TableStructure.xls)を開きます。
Set xlApp = New Excel.Application
Set xlWrkbk =
xlApp.Workbooks.Open(FileName:=strFilename, ReadOnly:=True)
DatabaseオブジェクトのOpenRecordsetメソッドで、tblTable, tblTableDetailsを開いたら、Do Until rs.EOF…Loopでテーブル構造をシート別に出力します。Sheets(“Template”).Selectでシートのテンプレートを選択したら、SelectionオブジェクトのCopyメソッドでコピーします。
.Sheets("Template").Select
.Cells.Select
.Selection.Copy
SheetsコレクションオブジェクトのAddメソッドで、シートを先頭に追加したら、ActiveSheetオブジェクトのPasteメソッドでTemplateのシートを貼り付けます。
.Sheets(1).Select
.Sheets.Add
.Sheets(1).Name =
strTableName
.Cells.Select
.ActiveSheet.Paste
Rangeプロパティで、レポートのヘッダー部の見出しと値を設定します。
.Range("A1").Value = "テーブル名"
.Range("C1").Value = "説 明"
.Range("F1").Value = "作成日"
.Range("G1").Value = "最終更新日"
.Range("A2").Value = rs!TableName
.Range("C2").Value = rs("tblTable.Description")
.Range("F2").Value = rs!DateCreated
.Range("G2").Value = rs!DateUpdated
Do While strTableName = rs!TableName…Loopでは、フィールドの情報をワークシートに設定します。フィールドが主キーのときは、フィールド名に下線を引きます。
.Cells(intRow, 1).Value = rs!OrdinalPosition + 1
.Cells(intRow, 2).Value = rs!FieldName
If rs!PrimaryKey Then
.Cells(intRow, 2).Select
xlApp.Selection.Font.Underline = xlUnderlineStyleSingle
End If
.Cells(intRow, 3).Value = rs!DataType
.Cells(intRow, 4).Value = rs!Size
.Cells(intRow, 5).Value = rs("tblTableDetails.Description")
全てのテーブルの処理を完了したら、罫線を引いてページ情報を設定します。最後に、Excelの可視（Visible）プロパティをTrueに設定したら、MsgBoxでメッセージを表示して、フォーカスをExcel 2000に移動します。MsgBoxのOKボタンをクリックしたら、Excel 2000を終了(Quit)させます。
リスト 74-5 ExportTableStructureのソースコード
|
Option Compare Database Option Explicit Private Const conFilename As String = "TableStructure.xls" Public Sub ExportTableStructure(fAutoFormat As Boolean, _ Optional varLeftHeader As Variant, _ Optional varCenterHeader As Variant, _ Optional varRightHeader As Variant, _ Optional varLeftFooter As Variant, _ Optional varCenterFooter As Variant = "&P / &N", _ Optional varRightFooter As Variant) ' ' Accessのテーブル構造をExcelに出力します。 ' Excelのレポートはテンプレート(TableStructure.xls)を開いて雛型とします ' Dim rs As DAO.Recordset Dim frm As Form Dim strSQL As String
Dim xlApp As Excel.Application Dim xlWrkbk As Excel.Workbook Dim xlWrksh As Excel.Worksheet Dim xlRange As Excel.Range
Dim strFilename As String Dim strTableName As String Dim strCell As String Dim intRow As Integer Dim intCol As Integer
On Error GoTo Err_ExportTableStructure DoCmd.Hourglass (True)
' テンプレートのパス名を取得します strFilename = CurrentProject.Path & "\" & conFilename
' ' Excel 2000を起動してテンプレート(TableStructure.xls)を読み込みモードで開きます ' Set xlApp = New Excel.Application Set xlWrkbk = xlApp.Workbooks.Open(FileName:=strFilename, ReadOnly:=True)
' ' Access Objectが格納されているテーブル(tblWork)を開きます '
strSQL = "SELECT tblTable.TableName, tblTableDetails.OrdinalPosition," _ & " tblTableDetails.FieldName, tblTableDetails.DataType," _ & " tblTableDetails.Size, tblTableDetails.PrimaryKey, " _ & " tblTableDetails.Description, tblTable.DateCreated, " _ & " tblTable.DateUpdated, tblTable.Description" _ & " FROM tblTable LEFT JOIN tblTableDetails ON " _ & " tblTable.TableName = tblTableDetails.TableName" _ & " ORDER BY tblTable.TableName, tblTableDetails.OrdinalPosition;"
Set rs = gmydb.OpenRecordset(strSQL, dbOpenSnapshot) With rs If .EOF Or .BOF Then MsgBox "該当するオブジェクトはありません！", vbExclamation GoTo Exit_ExportTableStructure End If End With
' -------------------------------------------- ' Table Structureを新規に追加したｼｰﾄ上に作成する ' -------------------------------------------- With xlApp rs.MoveFirst Do Until rs.EOF strTableName = rs!TableName
' ｼｰﾄのﾃﾝﾌﾟﾚｰﾄを新規に追加したｼｰﾄ上に複写する .Sheets("Template").Select .Cells.Select .Selection.Copy
' 新規に追加したｼｰﾄが常に先頭になるようにする .Sheets(1).Select .Sheets.Add .Sheets(1).Name = strTableName .Cells.Select .ActiveSheet.Paste
' ｼｰﾄのｵﾌﾞｼﾞｪｸﾄ変数に追加して先頭のｼｰﾄを設定する Set xlWrksh = .Sheets(1) With xlWrksh .Range("A1").Value = "テーブル名" .Range("C1").Value = "説 明" .Range("F1").Value = "作成日" .Range("G1").Value = "最終更新日"
.Range("A2").Value = rs!TableName .Range("C2").Value = rs("tblTable.Description") .Range("F2").Value = rs!DateCreated .Range("G2").Value = rs!DateUpdated
.Range("A3").Value = "No" .Range("B3").Value = "フィールド名" .Range("C3").Value = "データ型" .Range("D3").Value = "サイズ" .Range("E3").Value = "説 明"
intRow = 3 Do While strTableName = rs!TableName intRow = intRow + 1 .Cells(intRow, 1).Value = rs!OrdinalPosition + 1 .Cells(intRow, 2).Value = rs!FieldName
'主ｷｰなら下線を引く If rs!PrimaryKey Then .Cells(intRow, 2).Select xlApp.Selection.Font.Underline = xlUnderlineStyleSingle End If .Cells(intRow, 3).Value = rs!DataType .Cells(intRow, 4).Value = rs!Size .Cells(intRow, 5).Value = rs("tblTableDetails.Description") rs.MoveNext If rs.EOF Then Exit Do End If Loop End With
.Sheets(1).Select
' 不要な行を削除する .Rows(CStr(intRow + 1) & ":260").Select ' Rows(5:260).Select .Selection.Delete Shift:=xlUp
If fAutoFormat Then ' ｵｰﾄﾌｫｰﾏｯﾄ1,3を適用して書式設定 .ActiveSheet.Range("A1", "E" & CStr(intRow)).Select ' A1:E99 .Selection.AutoFormat _ Format:=xlRangeAutoFormatLocalFormat1, Number:=False, _ Font:=False, Alignment:=True, Border:=True, _ Pattern:=True, Width:=True
.Selection.AutoFormat _ Format:=xlRangeAutoFormatLocalFormat3, Number:=False, _ Font:=False, Alignment:=True, Border:=True, _ Pattern:=True, Width:=True Else ' 行見出しに網掛けする .Range("A1:G1").Select With .Selection.Interior .ColorIndex = 34 .Pattern = xlSolid End With .Range("A3:E3").Select With .Selection.Interior .ColorIndex = 34 .Pattern = xlSolid End With
' 罫線（格子型）を引く .ActiveSheet.Range("A1", "E" & CStr(intRow)).Select ' A1:E99 .Selection.AutoFormat _ Format:=xlRangeAutoFormatLocalFormat3, Number:=False, _ Font:=False, Alignment:=False, Border:=True, _ Pattern:=False, Width:=False End If
' ページのタイトル（行見出し）を設定する With .ActiveSheet.PageSetup .PrintTitleRows = "$1:$3" ' .PrintTitleColumns = "$A:$A" End With
' ページヘッダー/フッターを設定 With .ActiveSheet.PageSetup .LeftHeader = varLeftHeader .CenterHeader = varCenterHeader .RightHeader = varRightHeader .LeftFooter = varLeftFooter .CenterFooter = varCenterFooter .RightFooter = varRightFooter End With
' 用紙サイズ(A4)と印刷の向き（縦）設定 With .ActiveSheet.PageSetup .Orientation = xlPortrait ' xlLandscape .PaperSize = xlPaperA4 End With Loop ' Do Until .EOF rs.Close
' ----------------------------------------------- ' Excelを表示状態にして印刷前にカスタマイズ可能とする ' ----------------------------------------------- .Sheets(1).Select .Visible = True
' プレビュー印刷 ' .Selection.PrintOut Preview:=True, Collate:=True
End With ' xlApp
MsgBox "レポートをカスタマイズして印刷してください！" & vbCrLf _ & vbCrLf & "後で印刷するときは、別名で一旦保存してください！", _ vbInformation, "MyDoc2Xls"
Exit_ExportTableStructure: On Error Resume Next DoCmd.Hourglass (False)
If Not xlApp Is Nothing Then With xlWrkbk .Close SaveChanges:=False End With With xlApp .Quit End With Set xlWrksh = Nothing Set xlWrkbk = Nothing Set xlApp = Nothing End If
If Not rs Is Nothing Then rs.Close Set rs = Nothing End If Exit Sub
Err_ExportTableStructure: MsgBox Err.Number & " " & Err.Description Resume Exit_ExportTableStructure End Sub |