Option Compare Database
Option Explicit
' フォルダ選択ダイアログを表示し、選択されたフォルダを取得
Function GetFolder() As String
Dim fDialog As FileDialog
Dim varFolder As Variant
' FileDialogオブジェクトの作成
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "フォルダを選択してください"
.AllowMultiSelect = False
If .Show = -1 Then
For Each varFolder In .SelectedItems
GetFolder = varFolder
Next
Else
GetFolder = ""
End If
End With
Set fDialog = Nothing
End Function
' フォルダ内の全ファイルのフルパスとファイル名を再帰的に取得し、テーブルに格納
Sub ImportFilesToTableA(ByVal folderPath As String)
Dim fso As FileSystemObject
Dim folder As Folder
Dim subFolder As Folder
Dim file As File
Dim db As DAO.Database
Dim rs As DAO.Recordset
' FileSystemObjectの作成
Set fso = New FileSystemObject
Set folder = fso.GetFolder(folderPath)
' データベースとテーブルAのレコードセットを開く
Set db = CurrentDb
Set rs = db.OpenRecordset("TableA", dbOpenDynaset)
' フォルダ内の全ファイルを処理
For Each file In folder.Files
rs.AddNew
rs!フルパス = file.Path
rs!ファイル名 = file.Name
rs.Update
Next file
' サブフォルダを再帰的に処理
For Each subFolder In folder.SubFolders
ImportFilesToTableA subFolder.Path
Next subFolder
' リソースの解放
rs.Close
Set rs = Nothing
Set db = Nothing
Set file = Nothing
Set subFolder = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
' ボタンクリック時の処理
Private Sub btnImportFiles_Click()
Dim folderPath As String
' フォルダ選択ダイアログを表示
folderPath = GetFolder()
' フォルダが選択された場合、ファイル情報をテーブルにインポート
If folderPath <> "" Then
Call ImportFilesToTableA(folderPath)
MsgBox "ファイル情報がテーブルAにインポートされました。", vbInformation
Else
MsgBox "フォルダが選択されませんでした。", vbExclamation
End If
End Sub
コメント