指定したフォルダにあるすべてのファイル名を取得し、テーブルに記録・保存する例です。フォルダ内の画像をレポート上に出力するような場合に使えるかもしれません。
なお、フォルダ内にあるフォルダやその中のファイル名までは記録しませんのでご注意ください。
また、下記では実用性を考慮してフォームを用いていますが、その分Tipsと直接関係のない設定が多くなっています。あしからず。
例としてこのようなフォルダを用います。
このフォルダ内のすべてのファイル名を「ファイル名一覧保存.accdb」内のテーブルに記録するものとします。
まず記録先となるテーブル「ファイル名テーブル」を作ります。
「ファイル番号」と「ファイル名」の2列だけを持つ単純なテーブルです。
ファイル番号はファイルごとに1,2,3…と採番するものとします。また、主キーにしていますが実際はそこまでする必要はないと思われます。
次に、このテーブルをデータソースとするフォームを作成します(後でサブフォームとして用います)。「既定のビュー」プロパティは「データシート」とします。
次にメインフォームを作成し、次の3つのコントロールを置きます。
- テキストボックス…「名前」プロパティは「フォルダ名」
- ボタン…「名前」プロパティは「読み込み」
- サブフォーム…先ほど作成したフォームを置きます。「名前」プロパティは「ファイル名フォーム_サブフォーム」
「フォルダ名」という名前は「フォルダパス」の方がよかったかもしれません;-o-)
そしてメインフォームのフォームモジュールに下記のようなコードを記していきます。
基本的には次のような流れになっています。
- Dir関数の引数としてフォルダのパスを与えることにより最初のファイル名を取得し、ファイル番号1とともにテーブルに記録する
- 引数なしのDir関数により次のファイル名を取得できるのでファイル番号(2,3,4…)とともにテーブルに記録する。これをDir関数の戻り値が空文字列になる(つまりそれ以上ファイルがない)まで繰り返す
Option Compare Database Private Sub Form_Load() 'とりあえずaccdbのあるフォルダを表示 Me.フォルダ名 = CurrentProject.Path End Sub Private Sub 読み込み_Click() 'ファイル番号用変数 Dim i As Integer 'ファイル名用変数 Dim filename As String i = 0 'SQL実行時メッセージ非表示 DoCmd.SetWarnings False '一旦テーブルの全レコード削除 DoCmd.RunSQL "DELETE FROM ファイル名テーブル" 'フォルダ内の最初のファイル名取得 filename = Dir(Me.フォルダ名 & "\", vbNormal) Do Until filename = "" i = i + 1 'テーブルにファイル番号とファイル名を追加 DoCmd.RunSQL "INSERT INTO ファイル名テーブル(ファイル番号,ファイル名) VALUES(" & i & ",'" & filename & "')" '次のファイル名取得 filename = Dir Loop 'サブフォーム再表示 Me.ファイル名フォーム_サブフォーム.Requery 'SQL実行時メッセージ表示 DoCmd.SetWarnings True End Sub
※バックスラッシュは円マーク(¥)を表しています。
フォームビューで動かしてみます。
上記コードのはたらきによりaccdbファイルが存在するフォルダのパスが表示されています。もちろん他のフォルダを指定することもできます。
ボタンをクリックすると…
ファイル名がテーブルに記録され、サブフォーム上に表示されます。
先ほど見たフォルダ内のファイルは5つでしたが、accdbファイルを開いていますのでロックファイル(laccdb)も存在し、表示されています。