复制具有特定扩展名的文件名的位置

Question

我有下面的代码列出文件夹和子文件夹中的所有文件与路径。但我想列出只有特定扩展名的文件（例如：.txt文件）

我该怎么做..？

Code: 

Sub Test() 

Call ListFilesInFolder("D:\Downloads", True) 

End Sub 


Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean) 

Dim FSO As Object 
Dim SourceFolder As Object 
Dim SubFolder As Object 
Dim FileItem As Object 
Dim r As Long 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set SourceFolder = FSO.GetFolder(SourceFolderName) 
r = Range("A65536").End(xlUp).Row + 1 
For Each FileItem In SourceFolder.Files 
Cells(r, 1).Formula = FileItem.Name 
Cells(r, 2).Formula = FileItem.Path 
r = r + 1 ' next row number 
X = SourceFolder.Path 
Next FileItem 
If IncludeSubfolders 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 

Answer 1

您可以使用GetExtensionName Method这样的：

Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean) 

Dim FSO As Object 
Dim SourceFolder As Object 
Dim SubFolder As Object 
Dim FileItem As Object 
Dim r As Long 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set SourceFolder = FSO.GetFolder(SourceFolderName) 
r = Range("A65536").End(xlUp).Row + 1 

For Each FileItem In SourceFolder.Files 
    If FSO.GetExtensionName(FileItem) = "txt" Then 'change txt as you want 
    Cells(r, 1).Formula = FileItem.Name 
    Cells(r, 2).Formula = FileItem.Path 
    r = r + 1 ' next row number 
    End If 
    X = SourceFolder.Path 
Next FileItem 

If IncludeSubfolders 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