使用 VBA FileSystemObject,特定文件的文件扩展名
Using VBA FileSystemObject, specific file File extension
我正在使用以下代码列出文件夹及其子文件夹中所有扩展名为 xls、xlsx 或 xlsm 的文件。以下代码有效,但问题是,它列出了子文件夹中所有具有所有扩展名的文件,但仅列出了主文件夹中的 excel 文件。我不知道这段代码有什么问题。你能帮帮我吗?
Sub List_XL_Files(ByVal SheetName As String, 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 lRoMa As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
lRoMa = ThisWorkbook.Sheets(SheetName).Cells(Rows.Count, 2).End(xlUp).Row + 1
ReDim arrFolders(ctr)
With ThisWorkbook.Sheets(SheetName)
For Each FileItem In SourceFolder.Files
strFileExt = FSO.GetExtensionName(FileItem)
If strFileExt = "xlsm" Or strFileExt = "xlsx" Or strFileExt = "xls" Then
MsgBox strFileExt
.Cells(lRoMa + r, 1).Value = lRoMa + r - 7
.Cells(lRoMa + r, 2).Formula = strFileExt
.Cells(lRoMa + r, 3).Formula = FileItem.Name
.Cells(lRoMa + r, 4).Formula = FileItem.Path
.Cells(lRoMa + r, 5).Value = "-"
.Cells(lRoMa + r, 6).Value = ""
.Cells(lRoMa + r, 7).Value = ""
r = r + 1 ' next row number
X = SourceFolder.Path
End If
Next FileItem
End With
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SheetName, SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End sub
谢谢
在For Each SubFolder In SourceFolder.SubFolders
后添加以下代码
Call List_XL_Files(SheetName, SubFolder.Path, True)
它会起作用
我正在使用以下代码列出文件夹及其子文件夹中所有扩展名为 xls、xlsx 或 xlsm 的文件。以下代码有效,但问题是,它列出了子文件夹中所有具有所有扩展名的文件,但仅列出了主文件夹中的 excel 文件。我不知道这段代码有什么问题。你能帮帮我吗?
Sub List_XL_Files(ByVal SheetName As String, 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 lRoMa As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
lRoMa = ThisWorkbook.Sheets(SheetName).Cells(Rows.Count, 2).End(xlUp).Row + 1
ReDim arrFolders(ctr)
With ThisWorkbook.Sheets(SheetName)
For Each FileItem In SourceFolder.Files
strFileExt = FSO.GetExtensionName(FileItem)
If strFileExt = "xlsm" Or strFileExt = "xlsx" Or strFileExt = "xls" Then
MsgBox strFileExt
.Cells(lRoMa + r, 1).Value = lRoMa + r - 7
.Cells(lRoMa + r, 2).Formula = strFileExt
.Cells(lRoMa + r, 3).Formula = FileItem.Name
.Cells(lRoMa + r, 4).Formula = FileItem.Path
.Cells(lRoMa + r, 5).Value = "-"
.Cells(lRoMa + r, 6).Value = ""
.Cells(lRoMa + r, 7).Value = ""
r = r + 1 ' next row number
X = SourceFolder.Path
End If
Next FileItem
End With
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SheetName, SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End sub
谢谢
在For Each SubFolder In SourceFolder.SubFolders
Call List_XL_Files(SheetName, SubFolder.Path, True)
它会起作用