Check existing sheet in each checking excel file - excel

Question

function in this macro checking only opened excel for exsiting Sheet "economy" , but i need to check for exsisting this Sheet in each excel file i checking in folder and subfolders.
How i can edit this to check sheet name in not current macro excel file but in all files that i opened in sub "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
Thank you

Answer 1

I'd recommend to use Option explicit but leave that to you. I tweaked your code like that
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
Note that I moved the line rowIndex = rowIndex + 1out of the ifcondition and I use another function for checking if the workbook in question contains the worksheet you are looking for. The reason is that I want to avoid to open the workbook with Workbooks.open which could lead to trouble as Auto_open code would run.
Here is the function HasSheet I used
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
Function HasSheet is based on this answer