将参数从 VbScript 传递给 vba 函数

Question

我想从有参数的 vbscript 调用 vba 函数，我知道如何调用参数化子函数但遇到函数问题

这是我尝试过的，我在这里尝试了代码 Calling vba function(with parameters) from vbscript and show the result ，但这也没有用，它给出了预期的错误语句结束

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