特定の拡張子を持つファイル名の場所をコピーする

Question

フォルダとサブフォルダ内のすべてのファイルをpathで一覧表示するには次のコードを使用します。ただし、特定の拡張子のみを持つファイルを一覧にしたい（例：.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