mdb, mde, adp, adeの判別方法

上記のファイル(mdb, mde, adp, ade)を判定するのに、ファイル名の拡張子で判断するのは実に格好悪い(笑)ということで、判定するロジックをご紹介します。

CurrentProject, CurrentDb を CodeProject, CodeDb にしてもいいでしょうし、GetObject なんかを使えば、自分以外のファイルに関しても応用できると思います。
mdb と mde の判定部分だけでしたら Access97でも使用できます。

ProjectTypeプロパティや GetObject のことなどは、RURI++さんに教えてもらいました。

access_db_type.txt

Dim strMDE As String Select Case CurrentProject.ProjectType Case acADP On Error Resume Next strMDE = CurrentProject.Properties("MDE") If Err = 0 And strMDE = "T" Then MsgBox "ADE です" Else MsgBox "ADP です" End If On Error GoTo 0 Case acMDB On Error Resume Next strMDE = CurrentDb.Properties("MDE") If Err = 0 And strMDE = "T" Then MsgBox "MDE です" Else MsgBox "MDB です" End If On Error GoTo 0 Case Else MsgBox "不明" End Select

Accessデータベースをエクスプローラ上の右クリック（ショートカット メニュー）で最適化する方法

知ってる人は知っているんでしょうけど、エクスプローラでファイルを選択して右クリックした時に出てくるメニュー（ショートカット メニュー）ってカスタマイズできるんですね。実は私は知りませんでした。
そこで知らない人のために、ここに公開します（そんなオオゲサなもんか？）

(画像は Access97時代のものです ^^;)

エクスプローラのメニューから[表示]〜[オプション]を選択し[オプション]ダイアログ ボックスを表示する [ファイル タイプ]タブを選択し、[登録されているファイルタイプ]で「Microsoft Access データベース」を選択し〈編集〉ボタンをクリック

[ファイルタイプの編集]ダイアログ ボックスが表示されるので〈追加〉ボタンをクリック

[新しいアクション]ダイアログ ボックスが表示されるので以下のように入力して〈OK〉ボタンをクリック アクション Compact 別に CompactでなくてもOK アクションを実行するアプリケーション "C:\Program Files\Microsoft Office\Office\MSACCESS.EXE" /Compact /NOSTARTUP "%1" 環境により MSACCESS.EXEのフォルダが違うかもしれません フォルダ名に空白を含む場合等、MSACCESS.EXEまでを " で囲まないとエラーになりますよ

[ファイルタイプの編集]ダイアログ ボックスの[アクション]に追加した「Compact」が登録されました 〈終了〉ボタンをクリックして終了します

[オプション]ダイアログ ボックスを〈閉じる〉ボタンをクリックして終了

エクスプローラで Microsoft Accessデータベース(拡張子 mdbのファイル）を選択し、右クリックしてみると「Compact」が追加されてます 勇気のある人は実行してみましょう（笑）

フォーム等のオブジェクトをシステムテーブルから抽出する方法

一般に(?)、Accessの各オブジェクトの一覧を取得するのに、以下のコレクションを使用していると思います。

オブジェクト	コレクション
テーブル	TableDefs
クエリー	QueryDefs
フォーム	Containers("Forms").Documents
レポート	Containers("Reports").Documents
マクロ	Containers("Scripts").Documents
モジュール	Containers("Modules").Documents

オブジェクトの一覧をコンボボックスやリストボックスで使用する際、値集合タイプ(RowSourceType)を「値リスト」にして、値集合ソース(RowSource)にオブジェクト名を列挙することにより実現可能です。しかし、オブジェクト数が多かったり、名前が長かったりして、値集合ソース(RowSource)に（たぶん）2,048バイト以上を設定しようとするとエラーになってしまいます。

そこで、システムテーブルの MSysObjects から一覧を取得する方法をご紹介します。

テーブルからの抽出ですので、コンボボックスやリストボックスでは、値集合タイプ(RowSourceType)を「テーブル／クエリー」にして、値集合ソース(RowSource)に以下のSQLを設定すればOKです。
SQL文で抽出していますので、コンボボックスやリストボックス以外にも、いろいろ応用できるんじゃないでしょうか？

オブジェクト	SQL
テーブル	Select Name From MSysObjects Where Type = 1 And BitAnd(Flags, -2147483646) = 0(i)(iii)
クエリー	Select Name From MSysObjects Where Type = 5 And BitAnd(Flags, 1) = 0(ii)
フォーム	Select Name From MSysObjects Where Type = -32768
レポート	Select Name From MSysObjects Where Type = -32764
マクロ	Select Name From MSysObjects Where Type = -32766
モジュール	Select Name From MSysObjects Where Type = -32761

隠しオブジェクト(dbHiddenObject)を除外するには、各 Where句に And BitAnd(Flags, 8) = 0⁽ⁱⁱⁱ⁾ を付け加えて下さい。

1. システムオブジェクト(dbSystemObject)を除外しています


2. 理由は「TableDefs/QueryDefsコレクション中に作成した覚えのない TableDef/QueryDefオブジェクトが出てくることがある」を見てください。Access2000 でクエリー以外にテーブルでも予期せぬオブジェクトが出現したので、BitAnd(Flags, 1) = 0 ⁽ⁱⁱⁱ⁾ を全ての SQL に入れたほうがいいかもしれません。


3. SQLではビット演算してくれないみたいなんで関数を自作しました。

        Public Function BitAnd(ByVal lng1 As Long, ByVal lng2 As Long) As Long
            BitAnd = (lng1 And lng2)
        End Function

TableDefs/QueryDefsコレクション中に作成した覚えのない TableDef/QueryDefオブジェクトが出てくることがある

クエリー(QueryDefs)に ~sq〜 や ~TMPCLP〜 という名前のゴミやオバケと思えるものが出てくることがあります。その原因を追求してました。
ただ、あくまで私の出した結論であって 100%正しいかどうかは疑問ですので、信じるかどうかは皆さんにお任せします。

さて、この変な名前のクエリーは Access95までは出現していませんでした。つまり、Access97になって出現したようです。

システムテーブル MSysObjects のフィールド Type = 5 のものがクエリーに関する情報らしく、フィールド Flags がクエリーの種類をあらわしていると思われます。また、Flags の値は QueryDefオブジェクトの Typeプロパティの値に一致しているようです。

参考までに、まともな(データベース ウィンドウに表示されている)クエリー(QueryDefオブジェクト)の Typeプロパティの値は．．．選択クエリーは 0 (dbQSelect)、削除クエリーは 32 (dbQDelete)、更新クエリーは 48 (dbQUpdate)、追加クエリーは 64 (dbQAppend)等．．．（カッコ内は VBAの組み込み定数）。

ゴミやオバケと思われているクエリーには 2種類ありました。

一つは Flags = 1 となっているゴミ。クエリーを削除した直後に出現しましたが、ファイルを閉じる等のタイミングだと思うんですが、勝手に消滅します。このクエリーの名前は ~TMPCLPxxxxx というような感じで作成されるようです。

もう一つが Flags = 3 となっているもので、ゴミでもオバケでもありませんでした（考え方によってはオバケと言えるかもしれませんけどね）。
具体的には、フォームやレポートのレコードソース(RecordSource)プロパティが（クエリービルダを使ったりして）SQL文になっている場合や、コンボボックス等のコントロールの値集合ソース(RowSource)プロパティが前述のレコードソース プロパティと同様に SQL文になっているような場合に出現します。
これらの QueryDefオブジェクトの名前(Name)は、以下のような命名規則だと思われます。

Form の RecordSource に対応するもの	~sq_fフォーム名
Report の RecordSource に対応するもの	~sq_rレポート名
Form の Control の RowSource に対応するもの	~sq_cフォーム名^sq_cコントロール名
Report の Control の RowSource に対応するもの	~sq_dレポート名^sq_dコントロール名

そして結論としては．．．「（本当の）クエリーの一覧を取得する場合はQueryDefsコレクションから QueryDefオブジェクトの Typeプロパティが 1 または 3 のものを除外する」ということです。

その後、Access2000でテーブル(TableDefs)に ~TMPCLP〜 という名前のものが出てきました。でも上記クエリーの場合とは異なり Flags = 1 にはなっていないのです。でも他の正常な(?)オブジェクトでは Flags が偶数だったので、当面完璧と思える結論は．．．「Typeプロパティが奇数のものを除外する」ということです。

Accessの「ファイルを開く」などのダイアログを表示する方法

Accessで「ファイルを開く」とかのダイアログって、Windows標準のものじゃありませんよね。これの表示方法をご紹介します。

flags の値の意味とか、詳しいことは何もわかっていません (^_^;)。

access_dialog.txt

宣言部

Private Type OfficeGetFileName_Info hwndOwner As Long szAppName As String * 255 szDlgTitle As String * 255 szOpenTitle As String * 255 szFile As String * 4096 szInitialDir As String * 255 szFilter As String * 255 nFilterIndex As Long lView As Long flags As Long End Type Private Declare Function OfficeGetFileName _ Lib "msaccess.exe" Alias "#56" _ (gfni As OfficeGetFileName_Info, _ ByVal fOpen As Integer) As Long

「ファイルを開く」の例

Dim tOgfn As OfficeGetFileName_Info With tOgfn .hwndOwner = Me.Hwnd .szAppName = Me.Caption & vbNullChar .szOpenTitle = vbNullChar .szDlgTitle = "ファイルの選択" & vbNullChar .szFile = vbNullChar .szInitialDir = "C:\My Documents" & vbNullChar .szFilter = "Microsoft Access (*.mdb,*.mde,*.mda)|" & _ "*.mdb;*.mde;*.mda||" & vbNullChar .flags = &H2 If OfficeGetFileName(tOgfn, True) = 0 Then MsgBox Left$(.szFile, InStr(.szFile, vbNullChar) - 1) Else MsgBox "キャンセル" End If End With

「名前を付けて保存」の例

「ファイルを開く」の例の以下の部分の、True を False にすればいいです。 If OfficeGetFileName(tOgfn, True) = 0 Then ↓ If OfficeGetFileName(tOgfn, False) = 0 Then

「フォルダの選択」の例

Dim tOgfn As OfficeGetFileName_Info With tOgfn .hwndOwner = Me.Hwnd .szAppName = Me.Caption & vbNullChar .szOpenTitle = vbNullChar .szDlgTitle = "フォルダの選択" & vbNullChar .szFile = vbNullChar .szInitialDir = "C:\My Documents" & vbNullChar .szFilter = vbNullChar .flags = &H20 If OfficeGetFileName(tOgfn, True) = 0 Then MsgBox Left$(.szFile, InStr(.szFile, vbNullChar) - 1) Else MsgBox "キャンセル" End If End With

OpenArgs が Null に戻る

Access2000(でしか調べてませんが)で、フォームの OpenArgsプロパティを設定して開いた(DoCmd.OpenForm)にもかかわらず、なぜか Null に戻ってしまうという状況に遭遇したことがあります。

正式な文書も何も見つけたわけじゃないので、あくまで予想ですが、そのようになるフォームだけ、フォームのFilter と FilterOn や OrderBy と OrderByOnプロパティを使用しています。どうも、このプロパティのどれか(全て？)を設定すると OpenArgsプロパティが Null に戻されてしまうということが発生するようです。

---

とりあえず、フォームの開く時(Open)イベントでフォームモジュールの共通変数に格納して、以降はその変数を参照するようにしてます。

Dim fvarOpenArgs As Variant '' OpenArgsプロパティ （中略） Private Sub Form_Open(Cancel As Integer) fvarOpenArgs = Me.OpenArgs （中略） End Sub

もし何か情報をお持ちの方が居ましたら、発生原因を教えて下さい。

テーブルのリンク／再リンク

別のデータベース(mdbファイル)にあるテーブルをリンクしたり、リンク済テーブルを再リンクするためのプロシージャです。

再リンクは、インストール先のディレクトリが変わった場合などに使えます。

relink.txt

' @(f) ' ' 機能 : テーブル リンク ' ' 引き数 : ARG1 - Databaseオブジェクト ' ARG2 - ソーステーブル名 ' ARG3 - リンク元D/B名 ' ARG4 - リンク元D/Bパスワード ... 省略可 ' ARG5 - テーブル名 ... 省略可(省略時 ARG2) ' ' 機能説明 : ARG3(Database)の ARG2テーブルを ARG1(Database)にリンクする ' ' 備考 : ' Public Sub pLinkTable(db As DAO.Database, _ ByVal strSourceTableName As String, _ ByVal strOriginalDbName As String, _ Optional ByVal vPassword As Variant, _ Optional ByVal strTableName As String = "") Dim strConnect As String Dim td As DAO.TableDef strConnect = ";DATABASE=" & strOriginalDbName If Not IsMissing(vPassword) Then strConnect = strConnect & ";PWD=" & vPassword End If If strTableName = "" Then strTableName = strSourceTableName For Each td In db.TableDefs '' Table Exist If UCase(td.Name) = UCase(strTableName) Then If UCase(td.SourceTableName) <> UCase(strSourceTableName) Then db.TableDefs.Delete strTableName db.TableDefs.Refresh Exit For End If If UCase(td.Connect) <> UCase(strConnect) Then td.Connect = strConnect td.RefreshLink End If Exit Sub End If Next td '' Link Table Create Set td = db.CreateTableDef(strTableName) With td .SourceTableName = strSourceTableName .Connect = strConnect End With db.TableDefs.Append td db.TableDefs.Refresh Set td = Nothing End Sub

データベースまたはオブジェクトは読み取り専用であるため、 更新できません。

テキストファイルのインポートしようとすると「データベースまたはオブジェクトは読み取り専用であるため、 更新できません。」というエラーになる場合があります。

---

この問題は、Jet 4.0 の Text IISAM ににおけるセキュリティ上の弱点に対応したために、特定の拡張子のファイルしかアクセスできないようにしたためです。

詳しくは Microsoft のサポート技術情報の

Jet 4.0 の Text IISAM によりシステムファイルに行を付加できる

[ACC2000]ファイルのインポート/エクスポートで '読み取り専用' のエラーが発生する

をご覧下さい。

プリンタの列挙

実行するパソコンに設定されているプリンタ、および、そのプリンタが有する給紙方法をフォーム上のコンボボックスに列挙するサンプルです。

Access2000で作成してありますが、コンボボックスへの編集部分を書き直せば VB でも流用できます。

printer.zip

VB でも使えるかもしれません。