BlueIshDan
☠
- Local time
- Today, 12:49
- Joined
- May 15, 2014
- Messages
- 1,122
[CODE] Fill table with all subdirectories & files of database location.(DEPTH OPTION)
This is a set of code that allows you to place the access database file into a directory and then mine down to suck in all of the subdirectories' files into a table. The function allows for a depth setting, indicating how deep you would like to mine.
Here it is
TABLE: tbl_indexed_files
CODE:
Regards,
BlueIshDan
This is a set of code that allows you to place the access database file into a directory and then mine down to suck in all of the subdirectories' files into a table. The function allows for a depth setting, indicating how deep you would like to mine.
Here it is
TABLE: tbl_indexed_files
Code:
ID : AutoNumber
name: Text
path: Text
file: Text
CODE:
Code:
Private Sub btnMineDown_Click()
Dim rs As Recordset: Set rs = CurrentDb.OpenRecordset("tbl_indexed_files")
Dim fs As New FileSystemObject
RunSQL "DELETE * FROM tbl_indexed_files", False
For Each var_file In fs.GetFolder(CurrentProject.Path).Files
rs.AddNew
rs!Name = fs.GetFile(var_file).Name
rs!Path = fs.GetFile(var_file).ParentFolder.Path
rs!File = var_file
rs.Update
Next
For Each var_folder In GetSubFolders(CurrentProject.Path, 25)
For Each var_file In fs.GetFolder(var_folder).Files
rs.AddNew
rs!Name = fs.GetFile(var_file).Name
rs!Path = fs.GetFile(var_file).ParentFolder.Path
rs!File = var_file
rs.Update
Next
Next
MsgBox "Complete!: " & rs.RecordCount: DoEvents
rs.Close
End Sub
Public Function GetSubFolders(address, depth) As String()
Dim fs As New FileSystemObject
Dim sub_folders() As String
Dim folder_count As Long
Dim new_bundle_count As Long
Dim temp_folder_count As Long
' Check the existance of the directory.
If fs.FolderExists(address) Then
' Store the initial list of subfolders into an array.
For Each var_folder In fs.GetFolder(address).SubFolders
ReDim Preserve sub_folders(folder_count)
sub_folders(folder_count) = var_folder
folder_count = folder_count + 1
Next
' With i = 1, we will look into each of the initially collected _
' subfolders, and collect of their sub folders.
' For each increment until we reach the requested depth, we will
' collect the subfolders within each of the last result of subfolders.
' For your knowledge: _
' The result will return an array that seems
' to be sorted by depth.
For i = 1 To depth
temp_folder_count = folder_count
For j = new_bundle_count To temp_folder_count - 1
new_bundle_count = new_bundle_count + 1
For Each var_folder In fs.GetFolder(sub_folders(j)).SubFolders
ReDim Preserve sub_folders(folder_count)
sub_folders(folder_count) = var_folder
folder_count = folder_count + 1
Next
Next
Next
End If
GetSubFolders = sub_folders
End Function
Public Sub RunSQL(ByVal sql As String, ByVal set_warnings As Boolean)
If Not set_warnings Then: DoCmd.SetWarnings False
DoCmd.RunSQL sql, false
If Not set_warnings Then: DoCmd.SetWarnings True
End Sub
Regards,
BlueIshDan
Last edited: