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

Can't load vb on this computer so I can't use common dialog controls...which means I am stuck with the stuff in Excel and VBA.

zaza posted something like this on another thread:

VB Code:

Sub getfolder()
 
Dim dlgOpen As FileDialog
Dim strFolder As String
    Set dlgOpen = Application.FileDialog( _
        FileDialogType:=msoFileDialogFolderPicker)
    With dlgOpen
        .AllowMultiSelect = False
        .Show
    End With
'get the selected item into strFolder somehow
End Sub

This does get me the dialog box for folders (yay - figured that out) but I can't figure out how to get the selected folder into my string.

I tried adding:
strFolder = dlgOpen.selectedItems

but that just gets me a compile error 'argument not optional'

but since I don't know what arguments I need, that error is not so informative.

-- then somehow using that folder name I am using Dir to get the folders and files to drop into the Excel Spreadsheet...but let me fuss out that part. For now.

You were almost there on getting the path, here's some revised code that will give you the path, and also handles cases where the user presses Cancel.

VB Code:

Dim dlgOpen As FileDialog
Dim strFolder As String
    
    Set dlgOpen = Application.FileDialog( _
        FileDialogType:=msoFileDialogFolderPicker)
    
    strFolder = "No Folder Selected"
    
    With dlgOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            strFolder = dlgOpen.SelectedItems(1)
        End If
    End With
    
    MsgBox strFolder
End Sub

Ah, knew it was something simple...gotta have the item number :D

Now that would have been something useful to mention in the object browser.

Does that mean that the things selected get tossed into an array?

Thanks a ton...I am not going to mark this one as resolved yet. I might need more helps with getting the file info into the spreadsheet. But have to try first.

Quote:

---

Originally Posted by Kantalope

Does that mean that the things selected get tossed into an array?

---

Not quite, they are put into a collection rather than an array. The pluralization of SelectedItems is an indication that it is a collection ( a la Worksheets Vs. Worksheet).

What exactly does your procedure need to do once the user has selected a directory? I can't really tell from your posts?

The grand plan is to extract the folder contents: sub folders and files that contain our technical documents. The files need to be easy for our customers to browse so the tree is overly complicated and there are 500 some separate documents -- oh, and they need to be in two formats so double all that.

I wanted to be able to grab all of the folders, or the particular folder someone was interested in working with a dump the contents into Excel...then they can sort or compare or whatever it is they want to do. Figured I would get the "file name","modified date","file location(path)"

looks like dir can't help me like I thought...now I am leaning towards recursively searching with FSO...but am not married to the idea.

Then I have to figure out how to parse the crummy reports that source safe spits out but that is for next week.

FSO is the way to go.
Here's a recursive fuction that will, hopefully, give you what you need. I have also included a sample procedure showing how this function can be used.

VB Code:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
    
    '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)
    End If
    
    'Output the results to a sheet in the current book
    For lRecord = 1 To UBound(vFolderDetail, 2)
        With ThisWorkbook.Worksheets(3)
            .Cells(lRecord, 1) = vFolderDetail(1, lRecord)
            .Cells(lRecord, 2) = vFolderDetail(2, lRecord)
            .Cells(lRecord, 3) = vFolderDetail(3, lRecord)
            .Cells(lRecord, 4) = vFolderDetail(4, lRecord)
        End With
    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 all files in
'               a folder and (optionaly) is sub-folders.
'               The following data is included in the array
'                   File Name
'                   Last Mod Date
'                   File Path
'                   File Type
'               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
'                                   sub-folders should be included
'
' Date          Developer       Action
' --------------------------------------------------------------
' 03/23/06      Declan Kenny    Initial version
'
Function FolderDetails(ByVal FolderPath As String, ByVal IncludeSubFolders As Boolean) 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 lSubRecord As Long
    
    'Set the initial size of the return array
    ReDim vReturn(4, 1)
    
    'Create file system objects
    Set fsoFileSys = New Scripting.FileSystemObject
    Set oFolder = fsoFileSys.GetFolder(FolderPath)
    
    'Loop through each file un the folder
    'adding its properties to the array
    For Each oFile In oFolder.Files
        vReturn(1, UBound(vReturn, 2)) = oFile.Name
        vReturn(2, UBound(vReturn, 2)) = oFile.DateLastModified
        vReturn(3, UBound(vReturn, 2)) = Replace(oFile.Path, oFile.Name, "")
        vReturn(4, UBound(vReturn, 2)) = oFile.Type
        
        'Increase the size of the array by one
        ReDim Preserve vReturn(4, UBound(vReturn, 2) + 1)
    Next oFile
    
    'Remove the unused last record in the array
    ReDim Preserve vReturn(4, UBound(vReturn, 2) - 1)
    
    '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)
            
            'Pass the values from the sub-call into the return array
            For lSubRecord = 1 To UBound(vSubReturn, 2)
                ReDim Preserve vReturn(4, UBound(vReturn, 2) + 1)
                vReturn(1, UBound(vReturn, 2)) = vSubReturn(1, lSubRecord)
                vReturn(2, UBound(vReturn, 2)) = vSubReturn(2, lSubRecord)
                vReturn(3, UBound(vReturn, 2)) = vSubReturn(3, lSubRecord)
                vReturn(4, UBound(vReturn, 2)) = vSubReturn(4, lSubRecord)
            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

HolyMoly DKenny :eek: It will take me all day to figure out all that code lol

While I figure that all out, this is some stuff I cribbed off m$ but I keep getting an error 91 when I call the fso.getfolder

The listbox part was just to test the results if I could ever get there; and the extra variables are remnants of the original code and I have not cleaned all those up yet

VB Code:

Sub loadfolder()
 
Dim strFolder1 As String
   Dim nFolders As Long
   Dim nfiles As Long
   Dim lsize As Currency
   Dim sDir As String
   Dim sSrchString As String
    Dim Print_File As String
    Dim tfolder As Folder
    Dim tfil As File
    Dim filename As String
 
Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog( _
        FileDialogType:=msoFileDialogFolderPicker)
        
        strFolder1 = "no folder selected"
        
    With dlgOpen
        .InitialFileName = "c:\"
        .Title = "Select Folder to Load"
        .AllowMultiSelect = False
        If .Show = -1 Then
            strFolder1 = dlgOpen.SelectedItems(1)
            End If
    End With
 
 
'Part 2 get directory info
 
Dim fld As Folder
Dim fso As FileSystemObject
 
Set fld = fso.getfolder(strfolder1)
 
filename = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
                    vbHidden Or vbSystem Or vbReadOnly)
 
    While Len(filename) <> 0
    nfiles = nfiles + 1
    UserForm1.ListBox1.AddItem fso.BuildPath(fld.Path, filename) 'listbox test
    filename = Dir() 'getting next file
    DoEvents
    Wend
    '''''
 
'This part drops the file name into the spreadsheet
       'Print_File = fsoFiles(strFolder1, "*.*", nFolders, nfiles)
   'Range("a1").Select
   'Counter = 1
   'Do While Len(Print_File) > 0
   'If Print_File <> "vssver.scc" Then
    'Worksheets(ActiveSheet.Name).Cells(Counter, 1).Value = _
           'Print_File
    'End If  'Dont load the folder option file - no one cares
       'Print_File = Dir()
       'Counter = Counter + 1
   'Loop
 
End Sub

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.

VB Code:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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

Try copying my new code (post #8) into a fresh workbook and then run the "GetFileDetails" procedure. Let me know if this is what you want.

Kantalope
I had a typo in the code in pst #8. I have now corrected it.

Oh my god....that is so what I wanted to do.

You can't tell my boss that you did this in a few minutes and on a lark...I planned on goofing off for the rest of the day learning this stuff.

And the most referenced way to do this on the web was several modules deep and api calls and you just spit this stuff out.

Awesome DKenny...and the typo didn't seem to effect it but I will cut and paste again. That I know how to do.

Quote:

---

Originally Posted by Kantalope

I planned on goofing off for the rest of the day learning this stuff.

---

That's mainly how I learned too. :thumb:

I won't tell youre boss if you won't tell mine ;)

That code should go to the code bank...I can't believe more folks don't need to analyze folder contents...

:) :) :)