Tested in Excel 365 (16.8730.2046) 64-bit. All links open in new tab.
- Sub ListFilesOrFolders(Optional IsFile = True)
- Dim Param As String
- Dim RetVal, f, MyHeader, ResultSheet
- Dim MyFolder, MyDoc
- Dim strFile, i, arrData
- MyFolder = PickFileOrFolder(0)
- MyDoc = Environ("USERPROFILE") & "\Documents\"
- ToggleExcelFunctionalities (False)
- Param = ""
- If IsFile Then
- Param = "-"
- MyHeader = "File"
- ResultSheet = "List of Files"
- Else
- MyHeader = "Folder"
- ResultSheet = "List of Folders"
- End If
- f = FreeFile
- Open MyDoc & "List.bat" For Output As #f
- Print #f, "cd " & MyFolder
- Print #f, "dir " & MyFolder & "/s/b/a" & Param & "d>" & MyDoc & "Result.txt"
- Close f
- RetVal = Shell(MyDoc & "List.bat", vbHide)
- 'needs a pause to allow windows refresh
- Application.Wait (Now() + TimeValue("0:00:03"))
- ' transfer the result to sheet
- f = FreeFile
- Open MyDoc & "Result.txt" For Input As #f
- strFile = input(LOF(f), #f)
- Close f
- arrData = Split(strFile, vbCrLf)
- If SheetExists(ResultSheet) Then Sheets(ResultSheet).Delete
- Sheets.Add
- ActiveSheet.Name = ResultSheet
- Range("A1").Value = MyHeader
- Range("B1").Value = "Ignore"
- For i = 0 To UBound(arrData) - 1
- Cells(i + 2, 1).Value = arrData(i)
- Next i
- Kill MyDoc & "List.bat"
- Kill MyDoc & "Result.txt"
- ToggleExcelFunctionalities (True)
- End Sub
PickFileOrFolder function is here.
SheetExists function is here.