VBA - Check for System.ServiceModel.Channels.ServiceChannel faulted state before it raises an exception

I'm being forced to connect to some .net service in a VBA tool I'm developing. I use a function to return the cached instance or create a new one if it hasn't been created yet.

If anything goes wrong with the object (such as a connection time out), the next time I try to use it, I get the error

The communication object, System.ServiceModel.Channels.ServiceChannel, cannot be used for communication because it is in the Faulted state.

I've seen this error pop up all over the web, but all in proper languages that have try-catch blocks.

Rather than waiting for this error to occur when the cached instance gets used and dealing with it in an "On Error Goto" statement, I'd like to prevent it by happening when the cached object is retrieved for use. I couldn't find an object model for this thing anywhere, and setting up a watch on the initialized object just shows . What property or test can I use at retrieval time to determine whether the object is in a faulted state?

Private Function GetMRLDIntegrationService() As Object
    Const ServiceAddress = "service:mexAddress=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/Mex""," & _
            "address=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/""," & _
            "contract=""IMrldSimplexIntegration"", contractNamespace=""http://tempuri.org/""," & _
            "binding=""SimplexIntegration"", bindingNamespace=""http://tempuri.org/"""
    Static cachedInstance As Object
    If Not cachedInstance Is Nothing Then
        ''//If *DETECT ERROR STATE HERE* Then Set cachedInstance = Nothing
    End If
    If cachedInstance Is Nothing Then Set cachedInstance = GetObject(ServiceAddress)
    If cachedInstance Is Nothing Then Err.Raise 1, , _
        "The MRLD server did not respond to the request to provide the service object."
    Set GetMRLDIntegrationService = cachedInstance
End Function
开发者_开发问答

Elsewhere, in another method, this is where the error occurs, and this is when it's too late to deal with the error elegantly:

Private Sub FillFromRiskID(ByVal riskID As String)
    ...
    Process_MRLD_Result GetMRLDIntegrationService().GetSerializedRisk(riskID, "1", uName, pWord)
    ...
End Sub

Thanks for the help

This is the solution that works, but that I am trying to avoid, because it is ugly, and a waste of time in the majority of cases where there's nothing wrong with the cached object. GetSerializedRisk takes 15 seconds to return in some cases, even if the return value is an invalid login or bad request id.

Private Function GetMRLDIntegrationService() As Object
    Const ServiceAddress = "service:mexAddress=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/Mex""," & _
            "address=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/""," & _
            "contract=""IMrldSimplexIntegration"", contractNamespace=""http://tempuri.org/""," & _
            "binding=""SimplexIntegration"", bindingNamespace=""http://tempuri.org/"""
    Static cachedInstance As Object
    If Not cachedInstance Is Nothing Then
        ''If *DETECT ERROR STATE HERE* Then Set cachedInstance = Nothing
        On Error GoTo errorStateDetected
        cachedInstance.GetSerializedRisk "1", "1", "dummyrequest", "dummyrequest"
        GoTo everythingIsFine
errorStateDetected:
        Set cachedInstance = Nothing
        Resume everythingIsFine
everythingIsFine:
        ''//I just wasted a bunch of time
    End If
    If cachedInstance Is Nothing Then Set cachedInstance = GetObject(ServiceAddress)
    If cachedInstance Is Nothing Then Err.Raise 1, , _
        "The MRLD server did not respond to the request to provide the service object."
    Set GetMRLDIntegrationService = cachedInstance
End Function

This alternate solution give the GetService function an option to reset the cached object (i.e. if an error occured), the problem is that I cannot find a way to use this feature such that the Faulted state error can easily be reset, but other errors do not result in redundant erronous requests before the actual error gets processed.

Private Function GetMRLDIntegrationService(Optional ByVal reset As Boolean = False) As Object
    Const ServiceAddress = "service:mexAddress=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/Mex""," & _
            "address=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/""," & _
            "contract=""IMrldSimplexIntegration"", contractNamespace=""http://tempuri.org/""," & _
            "binding=""SimplexIntegration"", bindingNamespace=""http://tempuri.org/"""
    Static cachedInstance As Object
    If reset Then Set cachedInstance = Nothing
    If cachedInstance Is Nothing Then Set cachedInstance = GetObject(ServiceAddress)
    If cachedInstance Is Nothing Then Err.Raise 1, , _
        "The MRLD server did not respond to the request to provide the service object."
    Set GetMRLDIntegrationService = cachedInstance
End Function

And the calling function:

''/*If the cached object is in an error state there's no way to detect it without making a request, but
'making even a dummy request each use just to check would waste dozens of precious seconds per request,
'so this routine carefully makes the intended request, catches the error that might occur, then resets
'the connection and tries the request again. The upside is that a service object in an error state
'will be resolved immediately and transparently by opening a new connection as needed. The downside
'is that if any other error occurs (such as a 1 minute timeout error), the first occurrence will
'be a non-breaking error and it will actually repeat the error a second time before notifying the user,
'doubling the amount of time it takes any error to propogate. (In the case of a 1 minute time-out
'occurring, the request would occur twice for a total of 2 minutes delay until the application becomes
'responsive again.)*/
Private Sub FillFromRiskID(ByVal riskID As String)
    Const uName As String = "perftest1"
    Const pWord As String = "****"
    Dim result As String

    On Error GoTo retryGet
    Process_MRLD_Result GetMRLDIntegrationService().GetSerializedRisk(riskID, "1", uName, pWord)
    GoTo finally
retryGet:
    Resume retryGet2: 'Resets the error state so that a new error can be thrown
retryGet2:
    On Error GoTo invalidConnection
    Process_MRLD_Result GetMRLDIntegrationService(reset:=True).GetSerializedRisk(riskID, "1", uName, pWord)
finally:
    Exit Sub
invalidConnection:
    MsgBox "Error connecting to MRLD: " & Err.Description, vbCritical, "Fill From MRLD"
End Sub