Add File path and Names in a folder to access table

If you want to add the file name and complete path for all files existing in a folder.

Here is the code-


Option Compare Database
Dim fldpath
Dim fld, fil, subfld As Object
Sub list_of_file_names()
'tools->refrence-> micrososft office object library
DoCmd.SetWarnings (False)
' close the table if open
' we have taken a table File_Names_In_a_Directory with two fields file path and file name
DoCmd.Close acTable, "File_Names_In_a_Directory", acSaveYes
' delete the content of table
DoCmd.RunSQL "DELETE * FROM File_Names_In_a_Directory"
RefreshDatabaseWindow
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
Application.FileDialog(msoFileDialogFolderPicker).Show
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
getnames fld
DoCmd.SetWarnings (True)
End Sub

Sub getnames(ByRef prntfld)
Dim rcd As DAO.Recordset
Set rcd = CurrentDb.OpenRecordset("File_Names_In_a_Directory", dbOpenDynaset)
For Each fil In prntfld.Files
With rcd
.AddNew
.Fields![File Path].Value = fil.Path
.Fields![File name].Value = fil.Name
.Update
End With
Next fil
For Each subfld In prntfld.SubFolders
getnames subfld
Next subfld
rcd.Close
End Sub


Download Access Database