選択されたフォルダ内の全ファイル(サブフォルダも含む)のフルパスとファイル名を取得し、それらをテーブルAに格納

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

コメント