Передать параметр из VbScript в функцию vba

Question

Я хочу вызвать функцию vba из vbscript, у которой есть параметр. Я знаю, как вызвать параметризованную подпрограмму, но есть проблема с функцией

Вот то, что я пробовал, я попробовал код здесь Вызов функции vba (с параметрами) из vbscript и показ результата , но это также не сработало, выдало ошибку, как ожидалось, в конце оператора

Set xlObj = CreateObject("Excel.Application")
Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")

xlObj.Application.Visible = False
xlObj.Workbooks.Add

Dim result
result  = xlObj.Application.Run("Headers.xlsm!Headers",filename)

xlFile.Close True
xlObj.Quit

это моя функция vba

Function Headers(filename As String) As String

Application.ScreenUpdating = False

Dim myWb As Workbook
Dim i As Integer

Dim flag As Boolean
Set myWb = Workbooks.Open(filename:=filename)

Dim arr

arr = Array("col1","col2")

For i = 1 To 2
    If Cells(1, i).Value = arr(i - 1) Then
         Headers = "True"
    Else
         Headers = "False , Not Found Header " & arr(i - 1)
         Exit Function
End If
Next

myWb.Close

End Function

Answer 1

1. В вашем VBScript xlObj установлено как приложение Set xlObj = CreateObject("Excel.Application"). Это означает, что xlObj.Application должно быть только xlObj.

2. В вашем VBScript Filename не объявлено и не установлено в значение, поэтому оно пустое. Вам нужно определить значение для него.

   Set xlObj = CreateObject("Excel.Application")
   Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")
   
   xlObj.Visible = False
   xlObj.Workbooks.Add
   
   Dim Filename 'declare filename and set a value to it
   Filename = "E:\YourPath\Yourfile.xlsx"        
   
   Dim Result
   Result = xlObj.Run("Headers.xlsm!Headers", Filename)
   
   xlFile.Close True
   xlObj.Quit
   

3. В вашей функции вы используете Exit Function. Это немедленно остановит код, что означает, что ваша рабочая книга myWb не будет закрыта! Он остается открытым, потому что myWb.Close никогда не достигается. Измените Exit Function на Exit For, чтобы просто выйти из цикла и продолжить закрывать книгу.

4. Cells(1, i).Value не указано ни в какой книге, ни в какой таблице. Это не очень надежно, никогда не звоните Cells или Range без указания рабочей книги и рабочего листа (или Excel угадает, какой вы имеете в виду, и Excel может потерпеть неудачу, если вы не точны).

   Поэтому я рекомендуюиспользуйте что-то вроде myWb.Worksheets(1).Cells(1, i).Value, если вы всегда имеете в виду первый лист в этой книге. В противном случае, если у него есть определенное имя, его имя будет более надежным: myWb.Worksheets("SheetName").Cells(1, i).Value

5. Если вы выключите ScreenUpdating, не забудьте включить его в конце.

6. Обработка ошибок, если имя файла не существует, было бы неплохо не нарушать функцию.

7. Вы можете немного улучшить скорость, предположив Headers = "True"по умолчанию и просто включите его False на случай, если вы обнаружите несоответствующий заголовок. Таким образом, переменная устанавливается только один раз на True вместо нескольких раз для каждого правильного заголовка.

   Public Function Headers(ByVal Filename As String) As String    
       Application.ScreenUpdating = False
   
       Dim flag As Boolean 'flag is never used! you can remove it
   
       On Error Resume Next 'error handling here would be nice to not break if filename does not exist.
       Dim myWb As Workbook
       Set myWb = Workbooks.Open(Filename:=Filename) 
       On Error Goro 0 'always reactivate error reporting after Resume Next!!!
   
       If Not myWb Is Nothing Then            
           Dim Arr() As Variant
           Arr = Array("col1", "col2")
   
           Headers = "True" 'assume True as default and just change it to False if a non matching header was found (faster because variable is only set true once instead for every column).
           Dim i As Long 'better use Long since there is no benefit in using Integer
           For i = 1 To UBound(arr) + 1 'use `ubound to find the upper index of the array, so if you add col3 you don't need to change the loop boundings
               If Not myWb.Worksheets(1).Cells(1, i).Value = Arr(i - 1) Then 'define workbook and worksheet for cells
                    Headers = "False , Not Found Header " & Arr(i - 1)
                    Exit For '<-- just exit loop but still close the workbook
               End If
           Next i
       Else
           Headers = "File '" & Filename & "' not found!"
       End If
   
       Application.ScreenUpdating = True
       myWb.Close
   End Function