将参数从 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

在您的 VBScript xlObj 中设置为应用程序 Set xlObj = CreateObject("Excel.Application")。这意味着 xlObj.Application 应该只是 xlObj。

在您的 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

在您的函数中使用 Exit Function。这将在此时立即停止代码，这意味着您的工作簿 myWb 不会关闭！它保持打开状态，因为从未达到 myWb.Close。将 Exit Function 更改为 Exit For 以退出循环并继续关闭工作簿。
Cells(1, i).Value 既没有指定它在哪个工作簿中，也没有指定哪个工作表。这不是很可靠永远不要在没有指定工作簿和工作表的情况下调用 Cells 或 Range（或者 Excel 会猜测你的意思，如果你不精确，Excel 可能会失败).

因此，如果您总是指该工作簿中的第一个 worsheet，我建议使用类似 myWb.Worksheets(1).Cells(1, i).Value 的内容。或者，如果它有一个定义的名称，使用它的名称会更可靠：myWb.Worksheets("SheetName").Cells(1, i).Value
如果关闭ScreenUpdating最后别忘了开启
文件名不存在时的错误处理最好不要破坏函数。

您可以通过假设 Headers = "True" 为默认值来略微提高速度，如果您发现任何不匹配的 header，只需将其设置为 False。这样变量只设置一次 True 而不是多次设置为每个正确的 header.

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

将参数从 VbScript 传递到 vba 函数

Pass parameter from VbScript to vba function

vbscript

excel

vba