此宏中的函数检查仅打开了用于存在工作表“经济”的excel，但是我需要检查每个Excel文件中是否存在该工作表，请检查文件夹和子文件夹。我该如何编辑它来检查不是当前宏Excel文件中的工作表名称，而是我在子“ ListFilesInFolder”中打开的所有文件中的工作表名称？
Sub MainList()
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
If WorksheetExists("economy") = True Then
Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Path
Application.ActiveSheet.Cells(rowIndex, 3).Formula = "Есть"
Else
Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Path
Application.ActiveSheet.Cells(rowIndex, 3).Formula = "Нет"
rowIndex = rowIndex + 1
End If
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SubFolders
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function
谢谢
我建议使用，Option explicit但留给您使用。我这样调整你的代码
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
If HasSheet(xFile.ParentFolder & "\", xFile.Name, "economy") Then
Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.path
Application.ActiveSheet.Cells(rowIndex, 3).Formula = "Sheet exists"
Else
Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Name
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.path
Application.ActiveSheet.Cells(rowIndex, 3).Formula = "Sheet does not exist"
End If
rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SubFolders
ListFilesInFolder xSubFolder.path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
请注意，我将该行rowIndex = rowIndex + 1移出了if条件，并使用了另一个函数来检查所涉及的工作簿是否包含您要查找的工作表。原因是我要避免打开工作簿Workbooks.open，否则可能会在Auto_open代码运行时导致麻烦。
这是HasSheet我使用的功能
Function HasSheet(fPath As String, fName As String, sheetName As String) As Boolean
Dim f As String
Dim res As Variant
On Error GoTo EH
f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
res = ExecuteExcel4Macro(f)
If IsError(res) Then
HasSheet = False
Else
HasSheet = True
End If
Exit Function
EH:
HasSheet = False
End Function
功能HasSheet基于此答案
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句