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

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