On Error Resume Next?
I've had a problem with the following code, which is that sometimes a ADO connection will fail to open, and so an error is generated.
I added in an error handler for this, which basically closed all connections and recordsets and exited, because the subroutine was executed by a timer control every minute and it didn't matter if we missed one poll. However, it generated an error when closing the recordsets/connections. This in itself is not a surprise, because they won't be open - the strange thing is that it will not resume next, or indeed go to any error handler. It just continues to stubbornly raise errors.
I know there is a way around this (test for object state being open before closing), but I was curious if anyone else had seen this and if they managed to overcome it.
Public Sub Process(sourceQuery As String, destQuery As String, SyncType As String)
Dim conSource As New ADODB.Connection, conDest As New ADODB.Connection
Dim rsSource As New ADODB.Recordset, rsDest As New ADODB.Recordset
Dim retries As Integer
On Error GoTo ExitSub ' version 1.1.0; sometimes errors generated when opening
' connections; just exit and try later if this happens...
conSource.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Data Source = " & serverName & ";Initial Catalog=" & dbName
conDest.Open "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;" & _
"Dbq=" & dbaseFilesPath
' get source data, static as it may be updated while we are working...
rsSource.Open sourceQuery, conSource, adOpenStatic, adLockOptimistic
' get dest data...
On Error GoTo Flaky_Dbase_Driver
rsDest.Open destQuery, conDest, adOpenDynamic, adLockOptimistic
On Error GoTo 0
UpdateTable rsSource, rsDest, SyncType
UpdateLastSyncDate SyncType
' flow into error handler to close recordsets and connections...
ExitSub: ' version 1.1.0
' version 1.2.0 - added in if obj.state = open then obj.close
On Error Resume Next
rsSource.Close
Set rsSource = Nothing
rsDest.Close
Set rsDest = Nothing
conDest.Close
Set conDest = Nothing
conSource.Close
Set conSource = Nothing
Exit Sub
Flaky_Dbase_Driver:
' try removing the flicks to make the query work...
destQuery = Replace(destQuery, "`", "")
' keep trying...
On Error Resume Next
Err.Clear
' try opening a few times as it can be a bit obstreporous...
For retries = 1 To 10
rsDest.Open destQuery, conDest, adOpenDynamic, adLockOptimistic
If Not Err.Number <> 0 Then ' were any errors generated?
' no, recordset open and we can return to main execution flow...
Exit For
End If
Next
Resume Next
End Sub
|
