列出工作表中特定目录和字符数的文件名和路径

Question

我已经尝试并搜索了整个 vba 论坛，以弄清楚如何纠正我的代码（如下）以在特定目录及其子目录中搜索文件以列出和填充文件列表文件名长度为 20 个字符且只有 pdf 扩展名。

我想在 A 列末尾列出没有扩展名的文件列表，在 B 列列出完整的文件路径和名称。

还尝试在列表创建后对所有文件进行升序排序，但尚未成功:( 有帮助吗？谢谢

Sub ListPDF()

Range("A:L").ClearContents
Range("A1").Select

Dim strPath As String
strPath = "K:\Test\PDF\"
Dim OBJ As Object, Folder As Object, File As Object
Set OBJ = CreateObject("Scripting.FileSystemObject")
Set Folder = OBJ.GetFolder(strPath)
Call ListFiles(Folder)
Dim SubFolder As Object
For Each SubFolder In Folder.Subfolders
    Call ListFiles(SubFolder)
    Call GetSubFolders(SubFolder)
Next SubFolder
Range("A1").Select
End Sub

Sub ListFiles(ByRef Folder As Object)
For Each File In Folder.Files
       ActiveCell.Offset(1, 0).Select
        ActiveCell.Offset(0, 0) = File.Name
        ActiveCell.Offset(0, 1) = File.Path
Next File
End Sub

Sub GetSubFolders(ByRef SubFolder As Object)
    Dim FolderItem As Object
    For Each FolderItem In SubFolder.Subfolders
    Call ListFiles(FolderItem)
    Call GetSubFolders(FolderItem)
Next FolderItem
End Sub

Answer 1

使用这个：

Option Explicit

Dim fso As Object, fsoFolder As Object, fsoSubFolder As Object, fsoFile As Object

Public Sub ListPDFs()
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    ws.UsedRange.ClearContents

    Set fso = CreateObject("Scripting.FileSystemObject")

    Application.ScreenUpdating = False

        ShowPDFs ThisWorkbook.Path & "\..", ws

        ws.UsedRange.EntireColumn.AutoFit

    Application.ScreenUpdating = True

End Sub

Public Sub ShowPDFs(ByRef fsoPath As String, ByRef ws As Worksheet)
    Dim lastCell As Range, pdfName As String

    Set fsoFolder = fso.GetFolder(fsoPath)

    For Each fsoFile In fsoFolder.Files

        pdfName = fsoFile.Name

        If Len(pdfName) > 20 Then
            If InStr(1, pdfName, ".pdf") > 0 Then

                pdfName = Left(pdfName, InStrRev(pdfName, ".") - 1)
                Set lastCell = ws.Cells(ws.Rows.Count, 1).End(xlUp)

                lastCell.Offset(1, 0) = pdfName
                lastCell.Offset(1, 1) = fsoFile.Path
            End If
        End If
    Next

    For Each fsoSubFolder In fsoFolder.SubFolders
        ShowPDFs fsoSubFolder.Path, ws
    Next
End Sub

列出工作表中特定目录和字符数的文件名和路径

List files name and path in worksheet for specific dir and character count

extension-methods

vba

file