How to use a flexible folder address rather than the current one?

[alice2011]

Hi, I found a macro below which can list ALL the file names in the same folder as the saved macro file. My question is: how to adapt the code to allow a more flexible folder as specified, for example, C:\Users.

Sub ListFilesAndSubfolders()

  Dim FSO As Object
  Dim rsFSO As Object
  Dim baseFolder As Object
  Dim file As Object
  Dim folder As Object
  Dim row As Integer
  Dim name As String

  'Get the current folder
  Set FSO = CreateObject("scripting.filesystemobject")
  Set baseFolder = FSO.GetFolder(ThisWorkbook.Path)
  Set FSO = Nothing

  'Get the row at which to insert
  row = Range("A65536").End(xlUp).row + 1

  'Create the recordset for sorting
  Set rsFSO = CreateObject("ADODB.Recordset")
  With rsFSO.Fields
    .Append "Name", 200, 200
    .Append "Type", 200, 200
  End With
  rsFSO.Open

  ' Traverse the entire folder tree
  TraverseFolderTree baseFolder, baseFolder, rsFSO
  Set baseFolder = Nothing

  'Sort by type and name
  rsFSO.Sort = "Type ASC, Name ASC "
  rsFSO.MoveFirst

  'Populate the first column of the sheet
  While Not rsFSO.EOF
    name = rsFSO("Name").Value
    If (name <> ThisWorkbook.name) Then
      Cells(row, 1).Formula = name
      row = row + 1
    End If
    rsFSO.MoveNext
  Wend

  'Close the recordset
  rsFSO.Close
  Set rsFSO = Nothing

End Sub

Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object)

  'List all files
  For Each file In node.Files

    Dim name As String
    name = Mid(file.Path, Len(parent.Path) + 2)

    rs.AddNew
    rs("Name") = name
    rs("Type") = "FILE"
    rs.Update
  Next

  'List all folders
  For Each folder In node.SubFolders
    TraverseFolderTree parent, folder, rs
  Next

End Sub

[alice2011]

I'm still looking for a help

The location is:

Set baseFolder = FSO.GetFolder(ThisWorkbook.Path)

How can I change this to folder: C:\Users

[watersev]

hi alice2011, try this option (new lines are underlined):

Sub ListFilesAndSubfolders()

  Dim FSO As Object
  Dim rsFSO As Object
  Dim baseFolder As Object
  Dim file As Object
  Dim folder As Object
  Dim row As Integer
  Dim name As String
  Dim fd As Object, folder2process As String
  
  'Choose folder
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  If fd.Show = -1 Then folder2process = fd.SelectedItems(1) Else Exit Sub
  
  'Get the current folder
  Set FSO = CreateObject("scripting.filesystemobject")
  Set baseFolder = FSO.GetFolder(folder2process)
  Set FSO = Nothing

  'Get the row at which to insert
  row = Range("A65536").End(xlUp).row + 1

  'Create the recordset for sorting
  Set rsFSO = CreateObject("ADODB.Recordset")
  With rsFSO.Fields
    .Append "Name", 200, 200
    .Append "Type", 200, 200
  End With
  rsFSO.Open

  ' Traverse the entire folder tree
  TraverseFolderTree baseFolder, baseFolder, rsFSO
  Set baseFolder = Nothing

  'Sort by type and name
  rsFSO.Sort = "Type ASC, Name ASC "
  rsFSO.MoveFirst

  'Populate the first column of the sheet
  While Not rsFSO.EOF
    name = rsFSO("Name").Value
    If (name <> ThisWorkbook.name) Then
      Cells(row, 1).Formula = name
      row = row + 1
    End If
    rsFSO.MoveNext
  Wend

  'Close the recordset
  rsFSO.Close
  Set rsFSO = Nothing

End Sub

Private Sub TraverseFolderTree(ByVal parent As Object, ByVal node As Object, ByRef rs As Object)

  'List all files
  For Each file In node.Files

    Dim name As String
    name = Mid(file.Path, Len(parent.Path) + 2)

    rs.AddNew
    rs("Name") = name
    rs("Type") = "FILE"
    rs.Update
  Next

  'List all folders
  For Each folder In node.SubFolders
    TraverseFolderTree parent, folder, rs
  Next

End Sub

[alice2011]

Hi watersev, I totally feel amazed by this great improvement of the code. The new one is very flexible to allow me to choose the folder. Really good . Hope others can use it too.

Thanks for the great help.

[alice2011]

Sorry to come back. I ran the code and it works ok. But sometimes it failed to work and issued an error message as:

Run-time error '-2147217887 (80040e21)'):
Multiple-step operation generated errors. Check each status value.

The code may have some drawback behind which I don't know (I found it online).

Anyone knows?

[alice2011]