[RESOLVED] Got dialog now what? /Final goal: folder contents 2 Excel SO Resolved

[DKenny]

So, I'm really bored today....

Here's a revised version that is not limitted to those 4 file properties. In this version you can pass an array of properites to the function and get the values for each.

Again, I have a sample proc that shows how to use the function.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments:     Sample Proc showing how to use the FolderDetails
'               function
'
' Arguments:    None
'
' Date          Developer       Action
' --------------------------------------------------------------
' 03/23/06      Declan Kenny    Initial version
'
Sub GetFileDetails()
Dim sFolder As String
Dim vFolderDetail As Variant
Dim lRecord As Long
Dim lField As Long
    
    'Get the folder to document
    sFolder = GetFolder
    
    'Only continue if a folder has been chosen
    If sFolder = "" Then
        MsgBox "No Folder Selected", vbExclamation
    Else
        'Call the function to return the list of
        'file properties
        vFolderDetail = FolderDetails(sFolder, True, Array("Name", "Type", "DATELASTMODIFIED", "Size", "Path", "ShortPath"), True)
    End If
    
    'Output the results to a sheet in the current book
    For lRecord = LBound(vFolderDetail, 2) To UBound(vFolderDetail, 2)
        For lField = LBound(vFolderDetail) To UBound(vFolderDetail)
            ActiveWorkbook.Worksheets(3).Cells(lRecord + 1, lField + 1) = vFolderDetail(lField, lRecord)
        Next lField
    Next lRecord
End Sub
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments:     This function returns the full path to a single
'               folder chosen by the user
'
' Arguments:    None
'
' Date          Developer       Action
' --------------------------------------------------------------
' 03/23/06      Declan Kenny    Initial version
'
Function GetFolder() As String
Dim dlgOpen As FileDialog
Dim sFolder As String
    
    Set dlgOpen = Application.FileDialog( _
        FileDialogType:=msoFileDialogFolderPicker)
    
    With dlgOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            sFolder = dlgOpen.SelectedItems(1)
        End If
    End With
    
    GetFolder = sFolder
End Function
 
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments:     This function returns an array of properties for
'               all files in a folder and, optionaly, it sub-folders.
'               This function will be called recursively if
'               sub-folders are included.
'
' Arguments:    FolderPath          The full path to the folder
'                                   being documented.
'
'               IncludeSubFolders   Boolean to indicate if
'                                   sub-folders should be included
'
'               FileProps           An array of file properties to
'                                   be returned
'
'               FirstCall           A boolean used to indicate that
'                                   the function is being called
'                                   originally or recursively
'
' Date          Developer       Action
' --------------------------------------------------------------
' 03/23/06      Declan Kenny    Initial version
'
Function FolderDetails(ByVal FolderPath As String, _
                        ByVal IncludeSubFolders As Boolean, _
                        ByRef FileProps As Variant, _
                        Optional ByVal FirstCall As Boolean = True) As Variant
 
Dim fsoFileSys As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim oSubFolder As Scripting.Folder
Dim vReturn As Variant
Dim vSubReturn As Variant
Dim lPropNum As Long
Dim sPropValue As String
Dim lSubRecord As Long
    
    'Create file system objects
    Set fsoFileSys = New Scripting.FileSystemObject
    Set oFolder = fsoFileSys.GetFolder(FolderPath)
    
    'Set the initial size of the return array
    ReDim vReturn(LBound(FileProps) To UBound(FileProps), 0)
    
    'Add the Property headers to the return array
    'Only if they have not yet been added
    If FirstCall Then
        For lPropNum = LBound(FileProps) To UBound(FileProps)
            vReturn(lPropNum, 0) = FileProps(lPropNum)
        Next lPropNum
    End If
 
    'Loop through each file in the folder
    'adding its properties to the array
    For Each oFile In oFolder.Files
        'Increase the size of the array by one
        ReDim Preserve vReturn(LBound(FileProps) To UBound(FileProps), UBound(vReturn, 2) + 1)
        
        'Loop through the properties, adding each to the return array
        For lPropNum = LBound(FileProps) To UBound(FileProps)
            
            'Determine which file property to add
            Select Case UCase(FileProps(lPropNum))
                Case "DATECREATED":         sPropValue = oFile.DateCreated
                Case "DATELASTACCESSED":    sPropValue = oFile.DateLastAccessed
                Case "DATELASTMODIFIED":    sPropValue = oFile.DateLastModified
                Case "DRIVE":               sPropValue = oFile.Drive
                Case "NAME":                sPropValue = oFile.Name
                Case "PARENTFOLDER":        sPropValue = oFile.ParentFolder
                Case "PATH":                sPropValue = Replace(oFile.Path, oFile.Name, "")
                Case "SHORTNAME":           sPropValue = oFile.ShortName
                Case "SHORTPATH":           sPropValue = oFile.ShortPath
                Case "SIZE":                sPropValue = oFile.Size
                Case "TYPE":                sPropValue = oFile.Type
                Case Else:                  sPropValue = ""
            End Select
            
            'Add the propert to the array
            vReturn(lPropNum, UBound(vReturn, 2)) = sPropValue
        Next lPropNum
    Next oFile
    
    'Do sub-folders need to be included?
    If IncludeSubFolders Then
        
        'loop through each sub-folder
        For Each oSubFolder In oFolder.SubFolders
            
            'Recursive call to this function
            vSubReturn = FolderDetails(oSubFolder.Path, True, FileProps, False)
            
            'Pass the values from the sub-call into the return array
            For lSubRecord = 1 To UBound(vSubReturn, 2)
                ReDim Preserve vReturn(LBound(FileProps) To UBound(FileProps), UBound(vReturn, 2) + 1)
                For lPropNum = LBound(FileProps) To UBound(FileProps)
                    vReturn(lPropNum, UBound(vReturn, 2)) = vSubReturn(lPropNum, lSubRecord)
                Next lPropNum
            Next lSubRecord
        Next oSubFolder
    End If
    
    'Return the array
    FolderDetails = vReturn
    
    'Clean up
    Set oSubFolder = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
    Set fsoFileSys = Nothing
End Function