將參數從 VbScript 傳遞到 vba function

Question

I want to call a vba function from vbscript which has a parameter, I Know how to call a parameterized sub but having issue with function

這是我嘗試過的，我在這里嘗試了代碼Calling vba function(with parameters) from 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

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. 在您的 function 中，您使用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. 如果文件名不存在，錯誤處理最好不要破壞 function。

7. 您可以通過假設Headers = "True"作為默認值來稍微提高速度，如果您發現任何不匹配的 header，只需將其設置為False 。 這樣，對於每個正確的 header，變量只設置一次為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