Макс Кроман
Макс Кроман

Reputation: 27

Check existing sheet in each checking excel file

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

Upvotes: 1

Views: 95

Answers (1)

Storax
Storax

Reputation: 12177

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

Upvotes: 1

Related Questions