参考

Question

在Access中，使用VBA，我想使用Application.Run并捕获任何错误。不幸的是，Application.Run似乎劫持了错误捕获。有办法解决这个问题吗？

On Error Resume Next
Application.Run ...

即使我指定On Error Resume Next或On Error GoTo ErrCatch，我也永远不会错过Application.Run。我的错误捕获设置被忽略。

Answer 1

如果您要调用的程序在VBA项目中，那么您可以直接调用该程序：

Sub Foo()
   'Application.Run "SomeProc"
   SomeProc
End Sub

如果您需要能够按名称动态调用内容，则可以使用类和CallByName进行探索：

'In a standard module
Sub Foo()
   Dim o as New ProcRunner
   CallByName o, "SomeProc", VbMethod, args
End Sub

'In a class module called ProcRunner
Sub SomeProc()
   DoSomethingHere
   'Or, do something in a standard module
   Module1.SomeOtherProc
End Sub

或者，您可以按照以下方式编写自己的动态处理程序：

Sub AppRun(ProcName As String, ParamArray Args)
  Select Case ProcName
    Case "SomeProc"
        SomeProc
    Case "SomeFunc"
        SomeFunc
  End Select
End Sub

如果您正在调用另一个VBA项目中的过程，则可能需要添加对该项目的引用，具体取决于VBA主机。

但是，如果您正在使用Application.Run，因为您正在调用DLL或XLL注册的功能，那么除了使用{{1}之外，您没有其他选择}

Answer 2

有一种方法可以做到这一点。我们在VBA中具有测试工具，并且需要一种测试过程是否抛出错误并给出正确/错误结果的方法。我们希望True表示抛出了错误，而False表示没有抛出错误。这仅适用于公共过程，但是您可以传递可变数量的参数。

mIsErrorThrownDuringRunProcedure允许您传入proc名称和变量列表。它创建一个新模块，然后将另一个过程写入该新模块，调用另一个过程，然后返回结果。另一个过程检查使用给定的args运行proc是否有任何错误。动态创建的过程完成运行后，将删除新模块。

一个名为mCreateCodeToExecute的辅助函数创建从新模块运行的代码，以实际获得正确/错误的结果。

Public Function mIsErrorThrownDuringRunProcedure(pProcName As String, ParamArray pArgs() As Variant) As Boolean
    Dim lVbComp As Object
    Set lVbComp = ThisWorkbook.VBProject.VBComponents.Add(1)
    Dim lProcNameToExecute As String
    lProcNameToExecute = "mIsErrroRunDuringProcedure" & pProcName
    Dim lCodeToExecute As String
    Dim lNumArgs As Integer: lNumArgs = 0
    Dim lArg As Variant
    For Each lArg In pArgs
        lNumArgs = lNumArgs + 1
    Next
    lCodeToExecute = mCreateCodeToExecute(pProcName, lProcNameToExecute, lNumArgs)
    lVbComp.CodeModule.AddFromString lCodeToExecute
    mIsErrorThrownDuringRunProcedure = Application.Run(lProcNameToExecute, pArgs)
    ThisWorkbook.VBProject.VBComponents.Remove lVbComp
End Function

Private Function mCreateCodeToExecute(pProcName As String, lProcNameToExecute As String, numArgs As Integer)
    Dim lCodeToExecute As String
    lCodeToExecute = "Function " & lProcNameToExecute & "("
    lCodeToExecute = lCodeToExecute & "ParamArray pArgs() As Variant) As Boolean" & vbCrLf
    Dim lGoToLabel As String: lGoToLabel = "gtCodeHadError"
    lCodeToExecute = lCodeToExecute & "  On Error GoTo " & lGoToLabel & vbCrLf
    lCodeToExecute = lCodeToExecute & "  Call " & pProcName & "("
    Dim lIndex As Integer
    lIndex = 0
    For lIndex = 0 To numArgs - 1
        lCodeToExecute = lCodeToExecute & "pArgs(" & lIndex & "), "
        lIndex = lIndex + 1
    Next
    Dim lCutOff As Integer: lCutOff = 2
    If lIndex = 0 Then lCutOff = 1
    lCodeToExecute = left(lCodeToExecute, Len(lCodeToExecute) - lCutOff)
    If lCutOff = 2 Then lCodeToExecute = lCodeToExecute & ")"
    lCodeToExecute = lCodeToExecute & vbCrLf & "  " & lProcNameToExecute & "= False" & vbCrLf & "  Exit Function"
    lCodeToExecute = lCodeToExecute & vbCrLf & lGoToLabel & ":" & vbCrLf
    lCodeToExecute = lCodeToExecute & "  " & lProcNameToExecute & "= True"
    lCodeToExecute = lCodeToExecute & vbCrLf & "End Function"
    mCreateCodeToExecute = lCodeToExecute
End Function

参考

How to run a string as a command in VBA

带错误陷阱的Application.Run

2 个答案:

参考