I wanted to know whether any or all of these functions are possible in excel VBA or not:
List all the folders and sub folders within a local area (path name).
Produce a link so when displayed the user can open it from the spreadsheet.
Automatically update on the spreadsheet if user adds or deletes any files or folder/subfolder from a directory.
I did a quick example to show you how to list all files and sub folders:
Option Explicit
Private Sub test()
readFileSystem ("C:\Temp\")
End Sub
Private Sub readFileSystem(ByVal pFolder As String)
Dim oFSO As Object
Dim oFolder As Object
' create FSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
' get start folder
Set oFolder = oFSO.getFolder(pFolder)
' list folder content
listFolderContent oFolder
' destroy FSO
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Private Sub listFolderContent(ByVal pFolder As Object)
Dim oFile As Object
Dim oFolder As Object
' go thru all sub folders
For Each oFolder In pFolder.SubFolders
Debug.Print oFolder.Path
' do the recursion to list sub folder content
listFolderContent oFolder
Next
' list all files in that directory
For Each oFile In pFolder.Files
Debug.Print oFile.Path
Next
' destroy all objects
Set pFolder = Nothing
Set oFile = Nothing
Set oFolder = Nothing
End Sub
You could use CMD too:
Sub MM()
Dim fileResults As Variant
fileResults = GetFiles("C:\Users\Macro Man\Documents")
Range("A1").Resize(UBound(fileResults) + 1, 1).Value = _
WorksheetFunction.Transpose(fileResults)
End Sub
'// UDF to populate array with files, assign to a Variant variable.
Function GetFiles(parentFolder As String) As Variant
GetFiles = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & _
IIf(Right(parentFolder, 1) = "\", vbNullString, "\") & "*.*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
End Function
This is a lot quicker (takes a couple of seconds to do 1000+ files on a moderate spec PC) if you have lots of files as it doesn't need recursion.
This will list all the files in a selected folder (It will promt a dialog box so you can select the folder):
Force the explicit declaration of variables
Option Explicit
Create a function to select the folder where the files are:
Function ChooseFolder() As String
'function to select the folder where the files are
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
> Enter the routines to list all files in folder and sub-folders
Sub ListFiles2()
Range("A:H").Select
Selection.ClearContents
'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String, ProjectF As String
Dim i As Long
'Insert the headers for Columns A through F
Range("A1").Value = "File Name"
Range("B1").Value = "Parent Folder"
Range("C1").Value = "File Type"
Range("D1").Value = "Date Created"
Range("E1").Value = "Date Last Accessed"
Range("F1").Value = "Date Last Modified"
Range("G1").Value = "Author"
Range("H1").Value = "Last Saved by"
'strTopFolderName = "C:\Users\IGarcia\Documents\QMS\LaBella Engineering"
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the top folder
Set objTopFolder = objFSO.GetFolder(ChooseFolder)
'Call the RecursiveFolder routine
Call RecursiveFolder2(objTopFolder, True)
'Change the width of the columns to achieve the best fit
Columns.AutoFit
End Sub
Sub RecursiveFolder2(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long
Dim ws1 As Excel.Worksheet
Dim ws2 As Excel.Worksheet
Dim oFolder As Object, oFile As Object, objFile2 As Object
Set oFolder = CreateObject("Shell.Application").Namespace(objFolder.Path)
'Find the next available row
NextRow = Cells(Rows.Count, "C").End(xlUp).Row + 1
'Loop through each file in the folder
For Each objFile In objFolder.Files
Cells(NextRow, "A").Value = objFile.Name
Cells(NextRow, "B").Value = objFile.ParentFolder
Cells(NextRow, "C").Value = objFile.Type
Cells(NextRow, "D").Value = objFile.DateCreated
Cells(NextRow, "E").Value = objFile.DateLastAccessed
Cells(NextRow, "F").Value = objFile.DateLastModified
Set oFile = oFolder.ParseName(objFile.Name)
Cells(NextRow, "G") = oFolder.GetDetailsOf(oFile, 20)
Set objFile2 = CreateObject("DSOFile.OleDocumentProperties")
On Error Resume Next
objFile2.Open (objFile.Path)
Cells(NextRow, "H").Value = objFile2.SummaryProperties.LastSavedBy
NextRow = NextRow + 1
Next objFile
'Loop through files in the subfolders
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder2(objSubFolder, True)
Next objSubFolder
End If
End Sub
Here is an example how to get folders and files lists based on Scripting.FileSystemObject and Scripting.Dictionary ActiveX's, without recursive calls, only Do ... Loop:
Option Explicit
Sub Test()
Dim strFolder As String
Dim objFolders As Object
Dim objFiles As Object
Dim i As Long
Dim objItem As Object
' target folder
strFolder = "C:\Test"
' loop through all folders and files
Set objFolders = CreateObject("Scripting.Dictionary")
Set objFiles = CreateObject("Scripting.Dictionary")
objFolders(0) = strFolder
i = 0
With CreateObject("Scripting.FileSystemObject")
Do
With .GetFolder(objFolders(i))
For Each objItem In .Files
objFiles(objFiles.Count) = objItem.Path
Next
For Each objItem In .SubFolders
objFolders(objFolders.Count) = objItem.Path
Next
End With
i = i + 1
Loop Until i = objFolders.Count
End With
' results output to the 1st sheet
With Sheets(1)
.Select
.Cells.Delete
.Range(.Cells(1, 1), .Cells(objFolders.Count, 1)).Value = Application.Transpose(objFolders.Items)
.Range(.Cells(1, 2), .Cells(objFiles.Count, 2)).Value = Application.Transpose(objFiles.Items)
.Columns.AutoFit
End With
End Sub
Late answer, but posting for others who might have a similar problem.
I had a similar challenge but had the restriction of not being able to use FileSystemObject. Therefore, I wrote a Class library that makes heavy use of the Dir() function to parse all the files and folders in a specified directory. It requires you to set no references to additional libraries in the VBA IDE.
You can use it like this:
Sub PrintFilesAndFolders(Directory As DirectoryManager, Optional indent As String)
'Helper method
Dim folder As DirectoryManager
Dim file As DirectoryManager
Dim newIndent As String
For Each folder In Directory.Folders
Debug.Print indent & "+ " & folder.Name
newIndent = indent & " "
PrintFilesAndFolders folder, newIndent
Next folder
For Each file In Directory.Files
Debug.Print indent & "- " & file.Name
Next file
End Sub
Sub LoopThroughAllFilesAndFolders()
Dim dm As DirectoryManager
Set dm = New DirectoryManager
dm.Path = ThisWorkbook.Path & "\Sample Data Set"
PrintFilesAndFolders dm
End Sub
In the helper function, you can substitute the file.Name with file.Path, and instead of Debug.Print just write the output to your target workbook cell.
As far as watching for files changing on the system, I don't know of a way for Excel to automatically do that. At best, I think you would be able to write a script that runs when the workbook starts up to go reparse all the folders and files again and repopulate the workbook.
