특정 확장명의 파일 이름 위치 복사

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