在工作表中列出特定目錄和字符數的名稱和路徑

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