Search code examples
excelvbadirectorypicker

How to apply FileDialog(msoFileDialogFolderPicker) to pick a folder


I'm trying to add a folder selection dialog to my code.

I get

run-time error "Object variable or With block variable not set"

Dim ofso As Scripting.FileSystemObject
Dim oFolder As Object
Dim oFile As Object
Dim i As Long, colFolders As New Collection, ws As Worksheet
 
Set ws = Sheets.Add(Type:=xlWorksheet, After:=ActiveSheet)
Set ofso = CreateObject("Scripting.FileSystemObject")
'Set oFolder = ofso.GetFolder("F:\") This is the line to be replaced with the folder picker and what was being used before.
'Start folder picker
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
    oFolder = .SelectedItems(1) & "\"
End With

Then the code resumes with everything else that works when not using the folder picker.

It gives the error at

oFolder = .SelectedItems(1) & "\"

I tried playing with my object names

Set oFolder = Application.FileDialog(msoFileDialogFolderPicker)

With oFolder
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
    oFolder = .SelectedItems(1) & "\"
End With

Full code without the folder picker, to show what I'm trying to do.

Sub GetFilesColFunc()
    Application.ScreenUpdating = False
    
    Dim ofso As Scripting.FileSystemObject
    Dim FldrPicker As FileDialog
    Dim oFolder As Object
    Dim oFile As Object
    Dim i As Long, colFolders As New Collection, ws As Worksheet
 
    Set ws = Sheets.Add(Type:=xlWorksheet, After:=ActiveSheet)
    Set ofso = CreateObject("Scripting.FileSystemObject")
    Set oFolder = ofso.GetFolder("F:\")
    
    On Error Resume Next
           
    ws.Cells(1, 1) = "File Name"
    ws.Cells(1, 2) = "File Type"
    ws.Cells(1, 3) = "Date Created"
    ws.Cells(1, 4) = "Date Last Modified"
    ws.Cells(1, 5) = "Date Last Accessed"
    ws.Cells(1, 6) = "File Path"
    
    Rows(1).Font.Bold = True
    Rows(1).Font.Size = 11
    Rows(1).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
    Range("C:E").Columns.AutoFit
           
    colFolders.Add oFolder          'start with this folder
    
    Do While colFolders.Count > 0      'process all folders
        Set oFolder = colFolders(1)    'get a folder to process
        colFolders.Remove 1            'remove item at index 1
                    
        For Each oFile In oFolder.Files
            
                ws.Cells(i + 2, 1) = oFile.Name
                ws.Cells(i + 2, 2) = oFile.Type
                ws.Cells(i + 2, 3) = oFile.DateCreated
                ws.Cells(i + 2, 4) = oFile.DateLastModified
                ws.Cells(i + 2, 5) = oFile.DateLastAccessed
                ws.Cells(i + 2, 6) = oFolder.Path
                i = i + 1
            
        Next oFile

        'add any subfolders to the collection for processing
        For Each sf In oFolder.SubFolders
            If Not SkipFolder(sf.Name) Then colFolders.Add sf 'Skips folders listed within the referenced function
        Next sf
           
    Loop

    Application.ScreenUpdating = True
    
End Sub

Solution

  • You are confusing things, probably because you stared at your code for too long :)

    I botched together an example for you that hopefully illustrates some of the confusing stuff. Please note: I haven't done VBA in ages

    I divided up your problem into a few subsections.

    A FileDialog (aka the folderpicker built-in in Office) returns strings. So I put that into its own function.

    You cannot simply create an FSO Folder object by assigning a string to it. That is not how objects work, you have to bring them to live with the Set keyword. When you are new to VBS/VBA that is hard to understand at first. The GetFolder method from the Windows Scripting Host's FileSystemObject returns a Folder object. I put the output of that in the GetFSOFolder function. The GetFSOFolder returns an object, so you have to Set the variable (oFolder) that captures it

    Without the fluff that you decorated your OP with, here is an example of how you could approach this to just get the oFolder in your OP.

    It is probably longer than you want it to be, the reason being that I hope to clarify some things by being elaborate about it.

    
    Sub Main()
    
        Dim sFolder As String
        sFolder = FolderPicker() 'get the string representation from FileDialog
        If sFolder = "" Then
            Debug.Print "No folder was selected"
            Exit Sub
        End If
        
        'create a Folder object from the string
        Dim oFolder As Object
        Set oFolder = GetFSOFolder(sFolder)
    
        'what do we have?
        Debug.Print "Selected folder was: " & oFolder.path
        
    End Sub
    
    Function GetFSOFolder(path As String) As Object 'returns a Folder object if path is valid
        
        Dim ofso As Scripting.FileSystemObject
        Set ofso = CreateObject("Scripting.FileSystemObject")
        Set GetFSOFolder = ofso.GetFolder(path) 'note the Set, we are returning an object
    
    End Function
    
    Function FolderPicker() As String 'takes care of the folder picking dialog stuff
        Dim FldrPicker As FileDialog
        'Start folder picker
        Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With FldrPicker
            .Title = "Select A Target Folder"
            .AllowMultiSelect = False
            If .Show <> -1 Then Exit Function 'Check if user clicked cancel button
            FolderPicker = .SelectedItems(1) '.SelectedItems(1) returns a string!
        End With
    End Function