使用特定扩展名复制文件名的位置

时间:2016-07-06 12:30:06

标签: excel excel-vba macros vba

我有以下代码用于列出文件夹和子文件夹中包含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

1 个答案:

答案 0 :(得分:0)

您可以像这样使用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