Retrieve Subfolders Properties

[JayAndy]

Hi All

I'm trying to get a piece of code together to run through folders to see which ones haven't been used in a long time. I have managed to find and change a piece of Excel VBA code below but only gives me the information for the top files.

Anyone have an idea of how to run it so it gets me the sub-folders info aswell

Public Sub GetMetadata()
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strName As String
Dim strFotoName As String
Dim strPath As String
Dim strSize As String
Dim strDate As Date
Dim strADate As Date

Set dbs = CurrentDb
 
Set rst = dbs.OpenRecordset("tblFotosDetails", dbOpenDynaset, dbAppendOnly)
 
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Shell.Application")
 
'Get the folder object
Set objFolder = objFSO.Namespace("C:\BBM\BD89\Desktop\")
 
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Items
     'print file name
        strFotoName = objFile.Name
        'print file path
        strPath = objFile.Path
        'print file size
        strSize = objFile.Size
        strDate = objFolder.GetDetailsOf(objFile, 3)
        strName = objFolder.GetDetailsOf(objFile, 2)
        strADate = objFolder.GetDetailsOf(objFile, 5)
        
If strName = "File Folder" Then
'sent properties to access database
rst.AddNew
rst!Name = strName
rst!File = strFotoName
rst!Path = strPath
rst!Size = strSize
rst!DateT = strDate
rst!DateA = strADate
rst.Update
Else
'Do Nothing
End If

Next objFile

rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
 
End Sub

 

[static]

Your code comment doesn't match your code.

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Shell.Application")

filesystemobject

 

[JayAndy]

Your code comment doesn't match your code.

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Shell.Application")

filesystemobject

It was the comments of the person how created it.

 

[static]

I don't know what the values you are collecting are.

Private Sub Command0_Click()
    GetMetadata "C:\BBM\BD89\Desktop\"
End Sub

Public Sub GetMetadata(strPath As String)
    Dim rst As DAO.Recordset
    Dim objFolder As Object, f As Object
    Set rst = CurrentDb.OpenRecordset("tblFotosDetails", dbOpenDynaset, dbAppendOnly)
    Set objFolder = CreateObject("Scripting.FileSystemObject").getfolder(strPath)
    For Each f In objFolder.SubFolders
        rst.AddNew
            rst!Name = f.Name
            rst!File = f.Name
            rst!Path = f.Path
            rst!Size = f.Size
            rst!DateT = f.DateLastModified
            rst!DateA = f.DateLastAccessed
        rst.Update
    Next
    rst.Close
    Set rst = Nothing
End Sub

 

[JayAndy]

I don't know what the values you are collecting are.

Private Sub Command0_Click()
    GetMetadata "C:\BBM\BD89\Desktop\"
End Sub

Public Sub GetMetadata(strPath As String)
    Dim rst As DAO.Recordset
    Dim objFolder As Object, f As Object
    Set rst = CurrentDb.OpenRecordset("tblFotosDetails", dbOpenDynaset, dbAppendOnly)
    Set objFolder = CreateObject("Scripting.FileSystemObject").getfolder(strPath)
    For Each f In objFolder.SubFolders
        rst.AddNew
            rst!Name = f.Name
            rst!File = f.Name
            rst!Path = f.Path
            rst!Size = f.Size
            rst!DateT = f.DateLastModified
            rst!DateA = f.DateLastAccessed
        rst.Update
    Next
    rst.Close
    Set rst = Nothing
End Sub

Thanks Static but still only does the top files in the path.

 

[static]

In that case, Google "vba recursive subfolders"