Проверьте существующий лист в каждом проверяемом файле Excel

Question

Функция

в этом макросе проверяет только открытый 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

Спасибо

Answer 1

Я бы порекомендовал использовать 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 основана на этом ответе