MS Excel - Проверка наличия заданных полей среди всех листов книги (перед импортом например)

Пример эксплуатации:

Private Sub test0002()
Dim sPath$, sList$
Dim sWorksheetName As String

'Путь к файлу:
    sPath = "d:\Temp\Tabel_05.xlsx"

'Список полей для проверки (18 шт.):
    sList = "DateReport, Affilate, TabNum, FIO, HirDate, DisDate, SR_Name_Rus, " & _
            "Pr_Name_Rus, MainArea_VC, PersCatName, GrafikCode, Klg_Collar, " & _
            "Holiday_Beg, Holiday_End, Illness_Beg, Illness_End, DecretN, UhodN"
        
'Проверка:
    sWorksheetName = CheckFieldsInExcelWB(sPath, sList, 64) 
    
    If sWorksheetName = "" Then
        MsgBox "В файле:" & vbCrLf & sPath & vbCrLf & _
        "Не обнаружено данных для импорта." & vbCrLf & _
        "Пожалуйста укажите другой файл.", vbExclamation, "Ошибка! - Данные не найдены!"
    Else
        MsgBox "Файл:" & vbCrLf & sPath & vbCrLf & _
        "Успешно прошел проверку." & vbCrLf & _
        "В нем найден лист: [" & sWorksheetName & "].", vbInformation, "Данные найдены."
    End If
End Sub

Функция:

Private Function CheckFieldsInExcelWB(sFilePath$, sFieldsList$, Optional iFieldsEndCol% = 100) As String
'es - 30.08.2019 - 15.11.2019 v002
'Проверка наличия заданных полей в книге (перед импортом например) в произвольном порядке
'Возвращает название первого листа прошедшего проверку
'----------------------------------------------------------------
'Аргументы:
'   sFilePath$     'Ну понятно = путь к книге
'   sFieldsList    'Список названий полей через запятую
'   iFieldsEndCol  'Номер столбца = Конец заголовка полей (по умолч =100)
'----------------------------------------------------------------
Dim objExcelApp As Object
Dim objWorkBook As Object
Dim objWorkSheet As Object
Dim s$, iVal%, iValSub%, xVal%, vVal As Variant
Dim iTotalFields%, iFoundFields%
Dim arrFielsCheck() As String 'Массив полей которые проверяем
Dim arrFielsIn() As String    'Массив полей где проверяем

On Error GoTo CheckFieldsInExcelWB_Err
    
    's = Replace(sFieldsList, " ", "") 'Убираем пробелы!
    s = sFieldsList
    arrFielsCheck = Split(s, ",")     'Загоняем список в массив
    
    iTotalFields = UBound(arrFielsCheck)
    If iTotalFields = 0 Then
        MsgBox "Проверяемые поля не обнаружены!", vbCritical
        GoTo CheckFieldsInExcelWB_End
    End If
    
    'Debug.Print "Проверяемых полей: " & iTotalFields + 1 & " = " & xVal
    
    For iVal = LBound(arrFielsCheck) To iTotalFields
        arrFielsCheck(iVal) = Trim(arrFielsCheck(iVal)) 'На всякий случай ...
        'Debug.Print Format(iVal + 1, "000"); "=" & Trim(arrFielsCheck(iVal)) & "."
    Next iVal

    Set objExcelApp = CreateObject("Excel.Application")
    Set objWorkBook = objExcelApp.Workbooks.Open(sFilePath)

    
'Перебор всех листов книги
    s = ""
    iTotalFields = iTotalFields + 1
    For Each objWorkSheet In objWorkBook.WorkSheets
        'Debug.Print "Название листа: " & objWorkSheet.Name
        With objWorkSheet
            For iVal = 1 To iFieldsEndCol
                vVal = .Cells(1, iVal).Value
                'Debug.Print Format(iVal, "000") & " = " & vVal & "."
                If vVal <> "" Then s = s & vVal & ";"
            Next iVal
        End With
        
        arrFielsIn = Split(s, ";") 'Загоняем список в массив

        For iVal = LBound(arrFielsCheck) To UBound(arrFielsCheck)
            'Поиск среди обнаруженных в листе полей:
            For iValSub = LBound(arrFielsIn) To UBound(arrFielsIn)
                s = arrFielsIn(iValSub)
                If arrFielsCheck(iVal) = s Then 'поле найдено!
                    iFoundFields = iFoundFields + 1
                    'Debug.Print Format(iValSub + 1, "000"); " = N " & arrFielsIn(iValSub)
                    'Debug.Print "Найдено: " & iFoundFields & " из " & iTotalFields
                    Exit For
                End If
            Next iValSub
        Next iVal
        
        If iFoundFields >= iTotalFields Then 'всё найдено
            CheckFieldsInExcelWB = objWorkSheet.Name
            Exit For
        End If

    Next objWorkSheet
  
'Debug.Print "Найдено полей: " & iFoundFields
'Debug.Print "Найден лист: " & CheckFieldsInExcelWB & " iVal=" & iVal

CheckFieldsInExcelWB_End:
    On Error Resume Next
    
    objWorkBook.Close
    Set objWorkBook = Nothing
    objExcelApp.Quit
    Set objExcelApp = Nothing
    
    Err.Clear
    Exit Function

CheckFieldsInExcelWB_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function CheckFieldsInExcelWB.", _
        vbCritical, "Произошла ошибка!"
    Debug.Print "Line: " & Erl & "."
    Err.Clear
    Resume CheckFieldsInExcelWB_End

End Function