在工作表中列出文件名和路径以获取特定的目录和字符数 [英] List files name and path in worksheet for specific dir and character count

问题描述

我尝试过在vba论坛中进行搜索，以弄清楚如何纠正我的代码(在下面)以搜索特定目录中的文件及其子目录，以列出并填充文件名中包含20个字符的文件的列表长度，只有pdf扩展名.

I've tried and search through out vba forum to figure out how can I rectify my code (below) to search files within a specific directory and its sub-directories to list and populated list of file that have 20 characters in filename length and just only pdf extension.

我想在A列的末尾列出不带扩展名的文件，并在B列中列出完整的文件路径和名称.

I want to list of file with no extension at the end in column A and full file path and name in column B.

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

Also tried to sort all files ascending after list created but no success yet :( any help? Thanks

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

推荐答案

使用此:

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

这篇关于在工作表中列出文件名和路径以获取特定的目录和字符数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！