Question

此问题基于2015年的上一篇文章：VBA List all files (fast way) in subfolders without FileSystemObject

以下代码最初由MacroMan提供，效果很好。但是，每当我尝试获取文件名而不是完整路径时，它似乎都不起作用。需要进行哪些调整才能检索文件的名称。（例如，如果检索到的路径是C：/desktop/file.pdf我只想检索“文件”）

此外，如果excel中的列表不断刷新，并且相应的列具有用户输入，如何让用户输入与运行宏的更新信息一起移动，因此不会将其分配给文件那是没有关系的。（即如果“file1”在A1中并且日期“11/2”被手动输入到B1中，然后新文件被放入子文件夹中，导致“file1”向下移动几行到A7，我怎么能确保手动分配的日期“11/2”自动向下移动到B7以与“file1”重合？）

Sub SO()

Const parentFolder As String = "C:\Users\bloggsj\folder\" '// change as required, keep trailing slash

Dim results As String

results = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentFolder & "*.*"" /S /B /A:-D").StdOut.ReadAll

Debug.Print results

'// uncomment to dump results into column A of spreadsheet instead:
'// Range("A1").Resize(UBound(Split(results, vbCrLf)), 1).Value = WorksheetFunction.Transpose(Split(results, vbCrLf))
'//-----------------------------------------------------------------
'// uncomment to filter certain files from results.
'// Const filterType As String = "*.exe"
'// Dim filterResults As String
'// 
'// filterResults = Join(Filter(Split(results, vbCrLf), filterType), vbCrLf)
'//
'// Debug.Print filterResults
End Sub

我试图在这个脚本中使用FSO，但也没有成功：

Sub ListFiles()

    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
    Dim path As String

    path = Range("I3").Value
    strTopFolderName = "C:\" & path & "\"

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

    Call RecursiveFolder(objTopFolder, True)


End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubfolders As Boolean)

    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long

    NextRow = Cells(Rows.Count, "J").End(xlUp).Row + 1

    For Each objFile In objFolder.Files
        Cells(NextRow, "J8").Value = objFile.Name
        NextRow = NextRow + 1
        Next objFile

    If IncludeSubfolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder

    End If

End Sub

Answer 1

这似乎做得非常好。

Sub GetFilesInFolder(SourceFolderName As String, Subfolders As Boolean)

'--- For Example:Folder Name= "D:\Folder Name\" and Flag as Yes or No

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File
'Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    '--- This is for displaying, whereever you want can be configured

    r = 14
    For Each FileItem In SourceFolder.Files
        Cells(r, 2).Formula = r - 13
        Cells(r, 3).Formula = FileItem.Name
        Cells(r, 4).Formula = FileItem.Path
        Cells(r, 5).Formula = FileItem.Size
        Cells(r, 6).Formula = FileItem.Type
        Cells(r, 7).Formula = FileItem.DateLastModified
        Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

        r = r + 1   ' next row number
    Next FileItem

    '--- This is the Function to go each and Every Folder and get the Files. This is a Nested-Function Calling.

    If Subfolders = True Then
        For Each SubFolder In SourceFolder.Subfolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

从以下链接查看示例文件。

http://www.learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/#file-manager

点击名为“立即下载”的链接。

VBA使用CMD列出子文件夹中的所有文件，并使用手动输入数据进行排序

1 个答案: