Vba 在新的Excel实例中捕获打开的工作簿

我有许多宏，希望它运行一些代码，然后提示用户从另一个程序导出Excel工作簿，然后在打开导出后运行更多代码。棘手的是，一些程序导出到Excel的新实例，而其他程序则导出到当前实例

当前工作流是（底部的代码）：

使用导出的名称调用中央“捕获”模块（某些 程序导出“Book[x]”，有些导出“工作簿[x]”，等等）和 找到导出后要运行的过程

捕获模块从所有现有工作簿中获取所有工作簿名称的列表 Excel实例并另存为模块级字符串

捕获模块使用Application.OnTime，以便每3秒 扫描所有Excel实例中所有工作簿的列表

如果发现工作簿不在以前保存的工作簿列表中 所有现有工作簿名称，以及包含 导出时，它将工作簿存储为公共模块级变量， 并运行步骤1中保存的过程，该过程可以 存储工作簿

这在所有情况下都非常有效，只有一种情况除外。如果我已经在当前Excel实例中打开了Book1.xlsx，并且第三方程序将Book1.xlsx导出到新的Excel实例，则该程序不会将其识别为导出，因为Book1.xlsx已位于现有工作簿名称字符串数组中

我的解决方案是找到一种比“名称”或“路径”更好的唯一标识每个工作簿的方法。我尝试将现有工作簿名称字符串中的每个工作簿名称保存为[application.hwnd]！[工作簿名称]但这是一个不稳定的修复程序，经常出现故障（我真的不明白hwnd是如何工作的，所以我无法解释原因）

有什么想法吗？谢谢

使用MCaptureExport的示例过程

Public Sub GrabFXAllExport()

    Const sSOURCE As String = "GrabFXAllExport"

    On Error GoTo ErrorHandler

    If Not TAAA.MCaptureExport.bCaptureExport("FXALL", "TAAA.FXAllEmail.ProcessFXAllExport") Then Err.Raise glHANDLED_ERROR

ErrorExit:

    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Sub
Public Sub ProcessFXAllExport()

    Const sSOURCE As String = "ProcessFXAllExport"

    On Error GoTo ErrorHandler

    If MCaptureExport.mwbCaptured Is Nothing Then
        MsgBox "Exported Workbook Not Found. Please try again.", vbCritical, gsAPP_NAME
        GoTo ErrorExit
    End If

    Dim wsSourceSheet As Worksheet
    Set wsSourceSheet = MCaptureExport.mwbCaptured.Worksheets(1)
    Set MCaptureExport.mwbCaptured = Nothing

    [I now have the export and can work with it as a I please]

ErrorExit:

    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Sub

Public Function bWorkbookNamesAsArray(sResult() As String, Optional bAllInstances As Boolean = True) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bWorkbookNamesAsArray()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim i As Long, wb As Workbook
    Dim xlApps() As Application

    Dim ResultArray() As String
    Dim Ndx As Integer, wbCount As Integer

    If bAllInstances Then
        If Not bGetAllExcelInstances(xlApps) Then Err.Raise glHANDLED_ERROR
    Else
        ReDim xlApps(0)
        Set xlApps(0) = Application
    End If

    For i = LBound(xlApps) To UBound(xlApps)
        For Each wb In xlApps(i).Workbooks
            wbCount = wbCount + 1
        Next
    Next

    ReDim ResultArray(1 To wbCount)

    For i = LBound(xlApps) To UBound(xlApps)
        For Each wb In xlApps(i).Workbooks
            Ndx = Ndx + 1
            ResultArray(Ndx) = wb.Name
        Next
    Next

    sResult = ResultArray()

ErrorExit:

    bWorkbookNamesAsArray = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If


End Function
Public Function bGetAllExcelInstances(xlApps() As Application) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bGetAllExcelInstances()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim n As Long

    Dim hWndMain As LongPtr

    Dim app As Application

    ' Cater for 100 potential Excel instances, clearly could be better
    ReDim xlApps(1 To 100)

    hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)

    Do While hWndMain <> 0
        If Not bGetExcelObjectFromHwnd(hWndMain, app) Then Err.Raise glHANDLED_ERROR

        If Not (app Is Nothing) Then
            If n = 0 Then
                n = n + 1
                Set xlApps(n) = app
            ElseIf bCheckHwnds(xlApps, app.Hwnd) Then
                n = n + 1
                Set xlApps(n) = app
            End If
        End If
        hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)

    Loop

    If n Then
        ReDim Preserve xlApps(1 To n)
        'GetAllExcelInstances = n
    Else
        Erase xlApps
    End If

ErrorExit:

    bGetAllExcelInstances = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function


Private Function bCheckHwnds(xlApps() As Application, Hwnd As LongPtr) As Boolean

    On Error Resume Next

    Dim i As Integer

    For i = LBound(xlApps) To UBound(xlApps)
        If Not xlApps(i) Is Nothing Then
            If xlApps(i).Hwnd = Hwnd Then
                bCheckHwnds = False
                Exit Function
            End If
        End If
    Next i

    bCheckHwnds = True

End Function
Public Function bWorkbooksInSameApp(wb1 As Workbook, wb2 As Workbook, bSameApp As Boolean) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bWorkbooksInSameApp()"

    On Error GoTo ErrorHandler
    bReturn = True

    bSameApp = wb1.Application.Hwnd = wb2.Application.Hwnd

ErrorExit:

    bWorkbooksInSameApp = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If


End Function
Private Function bGetExcelObjectFromHwnd(ByVal hWndMain As LongPtr, aAppResult As Application) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bGetExcelObjectFromHwnd()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim hWndDesk As LongPtr
    Dim Hwnd As LongPtr
    Dim strText As String
    Dim lngRet As Long
    Dim iid As UUID
    Dim obj As Object

    hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)

    If hWndDesk <> 0 Then

        Hwnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)

        Do While Hwnd <> 0

        strText = String$(100, Chr$(0))
        lngRet = CLng(GetClassName(Hwnd, strText, 100))

        If Left$(strText, lngRet) = "EXCEL7" Then

            Call IIDFromString(StrPtr(IID_IDispatch), iid)

            If AccessibleObjectFromWindow(Hwnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK

                Set aAppResult = obj.Application
                GoTo ErrorExit

            End If

        End If

        Hwnd = FindWindowEx(hWndDesk, Hwnd, vbNullString, vbNullString)
        Loop

    End If

ErrorExit:

    bGetExcelObjectFromHwnd = bReturn
    Exit Function

ErrorHandler:
    MsgBox Err.Number
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function

MCaptureExport模块

Option Explicit
Option Base 1

' Description:  This module contains the central error
'               handler and related constant declarations.
Private Const msMODULE As String = "MCaptureExport"

Private sExistingWorkbookList() As String
Public mwbCaptured As Workbook
Public msCaptureType As String
Private sReturnProcedure As String
Private bListening As Boolean
Public Function bCaptureExport(sCaptureType As String, sRunAfterCapture As String) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bCaptureExport()"

    On Error GoTo ErrorHandler
    bReturn = True

    If Not bWorkbookNamesAsArray(sExistingWorkbookList, True, False) Then Err.Raise glHANDLED_ERROR

    sReturnProcedure = sRunAfterCapture
    bListening = True
    msCaptureType = sCaptureType
    TAAA.MCaptureExport.WaitForCapture sCaptureTypeToNameContains(msCaptureType)
    MsgBox "Waiting for " & msCaptureType & " Export", vbInformation, gsAPP_NAME

ErrorExit:

    bCaptureExport = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function

Private Sub WaitForCapture(sNameContains As String)

    Const sSOURCE As String = "WaitForCapture"

    On Error GoTo ErrorHandler

    Dim wbCaptureCheck As Workbook
    If Not bCaptureCheck(sNameContains, wbCaptureCheck) Then Err.Raise glHANDLED_ERROR

    If wbCaptureCheck Is Nothing Then
        If bListening Then _
            Application.OnTime Now + TimeSerial(0, 0, 3), "'TAAA.MCaptureExport.WaitForCapture " & Chr(34) & sNameContains & Chr(34) & "'"
    Else
        Dim bSameApp As Boolean
        If Not bWorkbooksInSameApp(ThisWorkbook, wbCaptureCheck, bSameApp) Then Err.Raise glHANDLED_ERROR

        If Not bSameApp Then
            Dim sTempFilePath As String
            sTempFilePath = ThisWorkbook.Path & "\temp_" & Format(Now, "mmddyyhhmmss") & ".xls"
            wbCaptureCheck.SaveCopyAs sTempFilePath
            wbCaptureCheck.Close SaveChanges:=False
            Set wbCaptureCheck = Application.Workbooks.Open(sTempFilePath)
        End If

        Set mwbCaptured = wbCaptureCheck
        bListening = False
        Application.Run sReturnProcedure
    End If

ErrorExit:

    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Sub
Private Function sCaptureTypeToNameContains(sCaptureType As String) As String

    sCaptureTypeToNameContains = "*"

    On Error Resume Next

    Select Case UCase(sCaptureType)
        Case "SOTER": sCaptureTypeToNameContains = "workbook"
        Case "THOR": sCaptureTypeToNameContains = "Book"
        Case "FXALL": sCaptureTypeToNameContains = "search_results_export"
    End Select

End Function
Private Function bCaptureCheck(sNameContains As String, wbResult As Workbook) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bCaptureCheck()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim i As Long, wb As Workbook
    Dim xlApps() As Application
    If Not bGetAllExcelInstances(xlApps) Then Err.Raise glHANDLED_ERROR
    For i = LBound(xlApps) To UBound(xlApps)
        For Each wb In xlApps(i).Workbooks

            If wb.Name Like "*" & sNameContains & "*" _
                And Not bIsInArray(wb.Name, sExistingWorkbookList) Then

                Set wbResult = wb
                GoTo ErrorExit

            End If
        Next
    Next

ErrorExit:

    bCaptureCheck = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function

MCaptureExport使用的实用程序功能

Public Sub GrabFXAllExport()

    Const sSOURCE As String = "GrabFXAllExport"

    On Error GoTo ErrorHandler

    If Not TAAA.MCaptureExport.bCaptureExport("FXALL", "TAAA.FXAllEmail.ProcessFXAllExport") Then Err.Raise glHANDLED_ERROR

ErrorExit:

    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Sub
Public Sub ProcessFXAllExport()

    Const sSOURCE As String = "ProcessFXAllExport"

    On Error GoTo ErrorHandler

    If MCaptureExport.mwbCaptured Is Nothing Then
        MsgBox "Exported Workbook Not Found. Please try again.", vbCritical, gsAPP_NAME
        GoTo ErrorExit
    End If

    Dim wsSourceSheet As Worksheet
    Set wsSourceSheet = MCaptureExport.mwbCaptured.Worksheets(1)
    Set MCaptureExport.mwbCaptured = Nothing

    [I now have the export and can work with it as a I please]

ErrorExit:

    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Sub

Public Function bWorkbookNamesAsArray(sResult() As String, Optional bAllInstances As Boolean = True) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bWorkbookNamesAsArray()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim i As Long, wb As Workbook
    Dim xlApps() As Application

    Dim ResultArray() As String
    Dim Ndx As Integer, wbCount As Integer

    If bAllInstances Then
        If Not bGetAllExcelInstances(xlApps) Then Err.Raise glHANDLED_ERROR
    Else
        ReDim xlApps(0)
        Set xlApps(0) = Application
    End If

    For i = LBound(xlApps) To UBound(xlApps)
        For Each wb In xlApps(i).Workbooks
            wbCount = wbCount + 1
        Next
    Next

    ReDim ResultArray(1 To wbCount)

    For i = LBound(xlApps) To UBound(xlApps)
        For Each wb In xlApps(i).Workbooks
            Ndx = Ndx + 1
            ResultArray(Ndx) = wb.Name
        Next
    Next

    sResult = ResultArray()

ErrorExit:

    bWorkbookNamesAsArray = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If


End Function
Public Function bGetAllExcelInstances(xlApps() As Application) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bGetAllExcelInstances()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim n As Long

    Dim hWndMain As LongPtr

    Dim app As Application

    ' Cater for 100 potential Excel instances, clearly could be better
    ReDim xlApps(1 To 100)

    hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)

    Do While hWndMain <> 0
        If Not bGetExcelObjectFromHwnd(hWndMain, app) Then Err.Raise glHANDLED_ERROR

        If Not (app Is Nothing) Then
            If n = 0 Then
                n = n + 1
                Set xlApps(n) = app
            ElseIf bCheckHwnds(xlApps, app.Hwnd) Then
                n = n + 1
                Set xlApps(n) = app
            End If
        End If
        hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)

    Loop

    If n Then
        ReDim Preserve xlApps(1 To n)
        'GetAllExcelInstances = n
    Else
        Erase xlApps
    End If

ErrorExit:

    bGetAllExcelInstances = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function


Private Function bCheckHwnds(xlApps() As Application, Hwnd As LongPtr) As Boolean

    On Error Resume Next

    Dim i As Integer

    For i = LBound(xlApps) To UBound(xlApps)
        If Not xlApps(i) Is Nothing Then
            If xlApps(i).Hwnd = Hwnd Then
                bCheckHwnds = False
                Exit Function
            End If
        End If
    Next i

    bCheckHwnds = True

End Function
Public Function bWorkbooksInSameApp(wb1 As Workbook, wb2 As Workbook, bSameApp As Boolean) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bWorkbooksInSameApp()"

    On Error GoTo ErrorHandler
    bReturn = True

    bSameApp = wb1.Application.Hwnd = wb2.Application.Hwnd

ErrorExit:

    bWorkbooksInSameApp = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If


End Function
Private Function bGetExcelObjectFromHwnd(ByVal hWndMain As LongPtr, aAppResult As Application) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bGetExcelObjectFromHwnd()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim hWndDesk As LongPtr
    Dim Hwnd As LongPtr
    Dim strText As String
    Dim lngRet As Long
    Dim iid As UUID
    Dim obj As Object

    hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)

    If hWndDesk <> 0 Then

        Hwnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)

        Do While Hwnd <> 0

        strText = String$(100, Chr$(0))
        lngRet = CLng(GetClassName(Hwnd, strText, 100))

        If Left$(strText, lngRet) = "EXCEL7" Then

            Call IIDFromString(StrPtr(IID_IDispatch), iid)

            If AccessibleObjectFromWindow(Hwnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK

                Set aAppResult = obj.Application
                GoTo ErrorExit

            End If

        End If

        Hwnd = FindWindowEx(hWndDesk, Hwnd, vbNullString, vbNullString)
        Loop

    End If

ErrorExit:

    bGetExcelObjectFromHwnd = bReturn
    Exit Function

ErrorHandler:
    MsgBox Err.Number
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function

公共函数bWorkBookNamesArray（sResult（）为字符串，可选bAllInstances为Boolean=True）为Boolean
变为布尔型
Const sSOURCE As String=“bWorkBookNamesArray（）”
关于错误转到错误处理程序
bReturn=True
Dim i与工作簿一样长，wb与工作簿一样长
Dim xlApps（）作为应用程序
Dim ResultArray（）作为字符串
Dim Ndx为整数，wbCount为整数
如果是这样的话
如果不是bGetAllExcelInstances（xlApps），则错误引发GLU错误
其他的
ReDim xlApps（0）
设置xlApps（0）=应用程序
如果结束
对于i=LBound（xlApps）到UBound（xlApps）
xlApps（i）工作簿中的每个wb
wbCount=wbCount+1
下一个
下一个
ReDim ResultArray（1到wbCount）
对于i=LBound（xlApps）到UBound（xlApps）
xlApps（i）工作簿中的每个wb
Ndx=Ndx+1
结果数组（Ndx）=wb.Name
下一个
下一个
sResult=ResultArray（）
错误退出：
bWorkBookNamesArray=bReturn
退出功能
错误处理程序：
bReturn=False
如果bCentralErrorHandler（msMODULE，sSOURCE），则
停止
简历
其他的
恢复错误退出
如果结束
端函数
作为布尔值的公共函数bGetAllExcelInstances（xlApps（）作为应用程序）
变为布尔型
Const sSOURCE As String=“bGetAllExcelInstances（）”
关于错误转到错误处理程序
bReturn=True
长
尺寸hWndMain为长PTR
Dim应用程序作为应用程序
“考虑到100个潜在的Excel实例，显然可能会更好
ReDim xlApps（1到100）
hWndMain=FindWindowEx（0&，0&，“XLMAIN”，vbNullString）
当hWndMain为0时执行此操作
如果不是bGetExcelObjectFromHwnd（hWndMain，app），则出现错误
如果不是（应用程序什么都不是），那么
如果n=0，则
n=n+1
设置xlApps（n）=应用
ElseIf bCheckHwnds（xlApps，app.Hwnd）然后
n=n+1
设置xlApps（n）=应用
如果结束
如果结束
hWndMain=FindWindowEx（0&，hWndMain，“XLMAIN”，vbNullString）
环
如果n那么
重拨应用程序（1到n）
'GetAllExcelInstances=n
其他的
删除xlApps
如果结束
错误退出：
bGetAllExcelInstances=bReturn
退出功能
错误处理程序：
bReturn=False
如果bCentralErrorHandler（msMODULE，sSOURCE），则
停止
简历
其他的
恢复错误退出
如果结束
端函数
私有函数bCheckHwnds（xlApps（）作为应用程序，Hwnd作为LongPtr）作为布尔值
出错时继续下一步
作为整数的Dim i
对于i=LBound（xlApps）到UBound（xlApps）
如果不是，xlApps（i）什么都不是
如果xlApps（i）.Hwnd=Hwnd，则
bCheckHwnds=假
退出功能
如果结束
如果结束
接下来我
bCheckHwnds=真
端函数
公共函数bWorkbooksInSameApp（wb1作为工作簿，wb2作为工作簿，bSameApp作为布尔值）作为布尔值
变为布尔型
Const sSOURCE As String=“bWorkbooksInSameApp（）”
关于错误转到错误处理程序
bReturn=True
bSameApp=wb1.Application.Hwnd=wb2.Application.Hwnd
错误退出：
bWorkbooksInSameApp=bReturn
退出功能
错误处理程序：
bReturn=False
如果bCentralErrorHandler（msMODULE，sSOURCE），则
停止
简历
其他的
恢复错误退出
如果结束
端函数
私有函数bGetExcelObjectFromHwnd（ByVal hWndMain作为LongPtr，aAppResult作为应用程序）作为布尔值
变为布尔型
Const sSOURCE As String=“bGetExcelObjectFromHwnd（）”
关于错误转到错误处理程序
bReturn=True
昏暗的hWndDesk作为长PTR
变暗Hwnd为长PTR
将strText设置为字符串
模糊的长度
作为UUID的Dim-iid
作为对象的Dim obj
hWndDesk=FindWindowEx（hWndMain，0&，“XLDESK”，vbNullString）
如果是0，那么
Hwnd=FindWindowEx（hwndtesk，0，vbNullString，vbNullString）
做
    Private Function bCaptureCheck(sNameContains As String, wbResult As Workbook) As Boolean

    Dim bReturn As Boolean
    Const sSOURCE As String = "bCaptureCheck()"

    On Error GoTo ErrorHandler
    bReturn = True

    Dim i As Long, wb As Workbook, sFullWorkbookReference As String
    Dim xlApps() As Application
    If Not bGetAllExcelInstances(xlApps) Then Err.Raise glHANDLED_ERROR
    For i = LBound(xlApps) To UBound(xlApps)
        For Each wb In xlApps(i).Workbooks

            sFullWorkbookReference = wb.Application.Hwnd & "!" & wb.Name

            If wb.Name Like "*" & sNameContains & "*" _
                And Not bIsInArray(sFullWorkbookReference, sExistingWorkbookList) Then

                If Not bGetWorkbookFromHwndAndName(sFullWorkbookReference, wbResult) Then Err.Raise glHANDLED_ERROR
                GoTo ErrorExit

            End If
        Next
    Next

ErrorExit:

    bCaptureCheck = bReturn
    Exit Function

ErrorHandler:
    bReturn = False
    If bCentralErrorHandler(msMODULE, sSOURCE) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If

End Function