UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> How Do I Get An Error To Interrupt Code When I Have, Access 2016    
 
   
bobalston
post May 21 2020, 01:22 PM
Post#1



Posts: 90
Joined: 12-October 04
From: Dallas area


How do i get an error to interrupt code when I have On Error Resume Next just before the offending line of code?
Attached File(s)
Attached File  ScreenHunter_354.jpg ( 77.15K )Number of downloads: 16
Attached File  ScreenHunter_353.jpg ( 47.51K )Number of downloads: 6
 
Go to the top of the page
 
theDBguy
post May 21 2020, 01:25 PM
Post#2


UA Moderator
Posts: 78,155
Joined: 19-June 07
From: SunnySandyEggo


Hi. Just a guess, but maybe you have your settings set to "break on all errors?"

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 
bobalston
post May 21 2020, 03:37 PM
Post#3



Posts: 90
Joined: 12-October 04
From: Dallas area


Nope. Set to "break on unhandled errors".

Bob
Go to the top of the page
 
cheekybuddha
post May 21 2020, 03:48 PM
Post#4


UtterAccess Moderator
Posts: 12,856
Joined: 6-December 03
From: Telegraph Hill


Hi, your error handler is hidden in the image.

I wonder whether the error that triggered the message box came from the prior call to Close the recordset.

Maybe post your whole procedure - there may be a better way to avoid the issue.

--------------------


Regards,

David Marten
Go to the top of the page
 
bobalston
post May 22 2020, 02:37 PM
Post#5



Posts: 90
Joined: 12-October 04
From: Dallas area


When I clicked on Debug, it highlighted the line of code as shown.

bob
Go to the top of the page
 
tina t
post May 22 2020, 04:48 PM
Post#6



Posts: 6,616
Joined: 11-November 10
From: SoCal, USA


i'm with David - can we see the entire procedure, pls?

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
bobalston
post May 22 2020, 07:52 PM
Post#7



Posts: 90
Joined: 12-October 04
From: Dallas area


Public Function DownloadCMBHSData(dlnumber As String, startdate As String, EndDate As String, CMBHSid As String, CMBHSpassword As String)
Dim XMLConnectString As String

Dim XMLResponseText As String
Dim ResponseText As String
Dim FileName As String
Dim work As String
Dim strstartdate As String
Dim strenddate As String
'Cteate XML Input document
Dim xmldoc
Set xmldoc = CreateObject("Microsoft.xmldom")
Dim textt As String
Dim i As Long
Dim L As Long

startdate = startdate + "T00:00:00"
EndDate = EndDate + "T00:00:00"

DownloadCMBHSData = ""
'Create XML Response Document
Dim xmlresponse
Set xmlresponse = CreateObject("Microsoft.xmldom")

ResponseText = ""

' Get XML/Soap input string
Dim db As dao.Database ' Defines the current Access database
Dim INrec As dao.Recordset ' Defines the input records
Set db = CurrentDb
Set INrec = db.OpenRecordset("tbl_CMBHS_Download_Parms")
INrec.MoveFirst
XMLConnectString = INrec.fields("XMLInput")

' UPdate XML Connect String with dl#, from date and to date
'XMLConnectString = Replace(XMLConnectString, "##", Str(INrec.Fields(DLnumber)))

strstartdate = Replace(startdate, "/", "-")
strenddate = Replace(EndDate, "/", "-")

''' XMLConnectString = Replace(XMLConnectString, "##########", strstartdate, , 1)
''' XMLConnectString = Replace(XMLConnectString, "##########", strenddate, , 1)
XMLConnectString = Replace(XMLConnectString, "##########", strstartdate, , 1)
XMLConnectString = Replace(XMLConnectString, "$$$$$$$$$$", strenddate, , 1)

XMLConnectString = Replace(XMLConnectString, "##", dlnumber)

If Location = "1598" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">1598<", 1)
If Location = "406435" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">406435<", 1)
If Location = "406438" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">406438<", 1)
If Location = "446101" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">446101<", 1)
If Location = "2144" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">2144<", 1)
If Location = "449684" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">449684<", 1)
If Location = "449736" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">449736<", 1)
If Location = "449737" Then XMLConnectString = Replace(XMLConnectString, ">479<", ">449737<", 1)

' load XML/Soap document from string
xmldoc.loadxml (XMLConnectString)






'Create the xmlhttp object
'dim xlmlttp

' 7.26.2012 set as object
'Dim xmlhttp As Object

'''''''Set xmlhttp = CreateObject("MSxml2.serverXMLHTTP")
Set xmlhttp = CreateObject("Msxml2.ServerXMLHTTP.3.0")

On Error GoTo 0
' milleseconds 1800000=30 min
' milleseconds 2700000=45 min
' milleseconds 3600000=60 min
' prior to 7-11-2012 setting was 30 minutes
' 7-11-2012 setting changed to 60 minutes
' 7-26-2012 setting changed to 30 minutes
' 8-2-2012 changed last parm to 45 min
'''''xmlhttp.setTimeouts 3600000, 3600000, 3600000, 5400000
'''' 5/2/2013 changed timeout to 20 minutes
''xmlhttp.setTimeouts 3600000, 3600000, 3600000, 2400000 ' changed to below May 19, 2020
xmlhttp.setTimeouts 300000, 300000, 300000, 300000

'Open a connection and send a request to the server in the form of an XML fragment
'''''Call xmlhttp.Open("POST", "http://cmbhstrn.dshs.state.tx.us/cmbhswebservice/service/downloadservice.asmx", False)
''''' Call xmlhttp.Open("POST", "https://cmbhs.dshs.state.tx.us/cmbhswebservice/Service/DownloadService.asmx", False)
''''' Call xmlhttp.Open("POST", "https://cmbhslast.dshs.state.tx.us/cmbhswebservice.last1/Service/DataDownloadService.asmx", False) '' test 2018-03-14
' Call xmlhttp.Open("POST", "https://cmbhs.dshs.state.tx.us/cmbhswebservice/Service/DataDownloadService.asmx", False) ''' production 2018-04-04
Call xmlhttp.Open("POST", "https://cmbhs.dshs.state.tx.us/cmbhswebservice/Service/DataDownloadService.asmx", False) ' use db copy during bus hours
On Error GoTo errHandler


' Send XML/SOAP document
Call xmlhttp.Send(xmldoc)


'Create an xml document object, and load the server's response

Set xmlresponse = CreateObject("Microsoft.XMLDOM")
xmldoc.async = False

' Set response string with XML/Soap response
ResponseText = xmlhttp.ResponseText
'Note: the ResponseXml property parses the server's response, responsetext doesn't
'xmlresponse.setcontenttype = "text/xml"

On Error GoTo errHandler

xmlresponse.loadxml (xmlhttp.ResponseText)

x = xmlhttp.getResponseHeader("Content-type")



' modify the encoding spec in the response
L = Len(ResponseText)
i = InStr(ResponseText, "utf-8")
If i = 0 Then
textt = "UTF-8 NOT found in response text"
If Len(ResponseText) > 0 Then textt = textt + Chr$(13) + ResponseText
Call SendERRORemail(textt)
textt = Left$(textt, 254)
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt

Exit Function
End If
If i > 0 Then ResponseText = Left(ResponseText, i - 1) + "ISO-8859-1" + Mid(ResponseText, i + 5, L)




' check for password expiration - logic added 2012-12-9
i = 0
i = InStr(ResponseText, "[PasswordExpiration]")
If i > 0 Then
textt = "Password expiration notice received - CHANGE Password!"
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt
Call SendERRORemail(textt)

' stop processing
DoCmd.Quit
End If

' check for invalid password to avoid too many attempts and disabling the account - logic added 2012-12-9
i = 0
i = InStr(ResponseText, "Invalid User ID]")
If i > 0 Then
textt = "Invalid User ID or Password"
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt
Call SendERRORemail(textt)
' stop processing
DoCmd.Quit
End If



' Write ResponseText to File

FileName = "c:\CMBHS\download\xmldata" + Trim(Str(dlnumber)) + ".xml"


' Set result message
i = InStr(xmlhttp.ResponseText, "<DownloadResult>")
j = InStr(xmlhttp.ResponseText, "<Data>")
k = InStr(xmlhttp.ResponseText, "<Message>No data found</Message>")
If j = 0 Or (j - i) > 18 Then

If k > 0 Then
' no data returned by server
textt = "No data returned=" & xmlhttp.ResponseText
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt
DownloadCMBHSData = "No data returned"
Exit Function
Else
textt = "No Message found in response TEXT=" & xmlhttp.ResponseText
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt
Call SendERRORemail(textt)
Call SendERRORemail(XMLConnectString)
Exit Function
End If
End If
'''''DownloadCMBHSData = Mid(xmlhttp.ResponseText, i + 9, Len(ResponseText)) 'captured the result = "transaction success." IF successful
DownloadCMBHSData = "Transaction success."

xmldoc.loadxml (ResponseText)
xmldoc.Save FileName





Exit Function

' Error Handler
errHandler:
If Err = -2146697205 Or Err = -2147012894 Then ' timeout
textt = "Timeout error" + " dl#= " + Str(dlnumber) + " loc= " + Location + " Startdate = " + Format(startdate)
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt
Call SendERRORemail(textt)
DownloadCMBHSData = "Error"
Exit Function
End If
If Err = -2146697208 Then ' timeout
textt = "Error -2146697208 No response received." + " dl#= " + Str(dlnumber) + " loc= " + Location + " Startdate = " + Format(startdate)
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt
Call SendERRORemail(textt)
DownloadCMBHSData = "Error"
Exit Function
End If

textt = "Error in receive XML - Err No " + Str(Err) + " " + Err.Description + " dl#= " + Str(dlnumber) + " loc = " + Str(Location) + "startdate = " + Format(startdate)

Call SendERRORemail(textt)
WriteHistory "DownloadCMBHSData ERROR!!!", " ", 0, 0, textt

Call SendERRORemail(textt)
DownloadCMBHSData = "Error"
Exit Function

errHandler2:

textt = "Error other than during D/L. " + Err.Number & ": " & Err.Description + " dl#= " + Str(dlnumber) + " loc= " + Location + " Startdate = " + Format(startdate)

WriteHistory "Process D/L CMBHS Data ERROR!!!", " ", 0, 0, textt
Call SendERRORemail(textt)
Exit Function
End Function
Go to the top of the page
 
tina t
post May 22 2020, 11:38 PM
Post#8



Posts: 6,616
Joined: 11-November 10
From: SoCal, USA


hmm, am i missing something? i didn't find the smaller block of code that you originally posted, anywhere in the larger block of code that you last posted. if i managed to miss it even after looking three times, will you excuse these getting-older eyes and point it out to me, pls?

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
bobalston
post May 23 2020, 12:18 PM
Post#9



Posts: 90
Joined: 12-October 04
From: Dallas area


Oops. My apologies. I think the code below is correct:
CODE
Function AddEditPhone()
Dim i As Long

Dim Comments As String
Dim textt As String
Dim totalcnt As Integer
Dim ClientNumber As Long
Dim ClientPhoneNumber As String
Dim clientPhoneType As String
Dim AdmissionNumber As Long
Dim DischargeNumber As Long
Dim Screeningdate As Date
Dim FollowupNumber As Long
Dim update As Boolean
Dim RecordCreation, RecordUpdate As Date
Dim fieldname As String
Dim typeloc As String
Dim loccode As Integer
Dim myerr As String
Dim myerrdescr As String
Dim myclientnbr As Long


' Delete leftover imported tables
On Error Resume Next
   ' CurrentDb.TableDefs.Delete ("CMBHSAuthenticationHeader")
   ' CurrentDb.TableDefs.Delete ("Client")
   ' CurrentDb.TableDefs.Delete ("ClientContact")
   ' CurrentDb.TableDefs.Delete ("Comment")
   ' CurrentDb.TableDefs.Delete ("OrganizationClient")
   ' CurrentDb.TableDefs.Delete ("ServiceError")

   i = DeleteAllRecords("CMBHSAuthenticationHeader")
   i = DeleteAllRecords("Client")
   i = DeleteAllRecords("clientcontact")
   i = DeleteAllRecords("comment")
   i = DeleteAllRecords("organizationclient")
   i = DeleteAllRecords("serviceerror")
  


On Error GoTo Phone_error_Handler



    
Set rstdownloaded = New ADODB.Recordset
'Set rststats = New ADODB.Recordset
totalcnt = 0
update = False
rstdownloaded.Open ("SELECT * FROM ClientPhone"), CurrentProject.Connection, adOpenKeyset, , adCmdText
With rstdownloaded


Do Until .eof
    loccode = 0
    ClientNumber = 1000000000 + Val(.fields("clientNbr"))
    myclientnbr = ClientNumber
    
    
    ClientPhoneNumber = .fields("clientphonenbr")
    clientPhoneType = .fields("clientphonetype")
    
    '*** added 5/22/2012 To resolve occasional error ****
    On Error Resume Next
    rststats.Close
    Set rststats = Nothing
    Set rststats = New ADODB.Recordset
    On Error GoTo Phone_error_Handler
  
    '*****************************************************

    rststats.Open ("Select * FROM tbl_clientPhone " & _
       " WHERE [clientphonenbr] = '" & ClientPhoneNumber & "'" & "and  [clientphonetype] = '" & clientPhoneType & "'" & _
       " and [clientnbr] = " & Str(ClientNumber)), _
        CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTableDirect

    If Not rststats.eof Then
        If Val(ClientNumber) <> Val(rststats.fields("clientnbr")) Then
        
            textt = DataFile & "  Client numbers do not match - -  downloaded client_number = " & rstdownloaded.fields("clientnbr") & "  database client number = " & rststats.fields("client_number") & "Change not made."

            WriteHistory "Update Records ERROR!!!!!!!", "ClientPhone", 0, 0, textt
            Call SendERRORemail(textt)
            rststats.Close
            Set rststats = Nothing
            GoTo movenext
            End If
        
        
        '''''RSTstats.Edit   This is only used in DAO not in ADO which is what I am using
      
        Else
      
        rststats.AddNew
        
        End If
   On Error GoTo Phone_error_Handler
  
  If IsNull(rststats.fields("UpdatedDate")) Or .fields("Updateddate").Value > rststats.fields("UpdatedDate") Then
  
    loccode = 1
    rststats.fields("ClientPhoneNbr") = .fields("ClientPhonenbr").Value
      loccode = 2
    rststats.fields("ClientNbr") = ClientNumber
      loccode = 3
    rststats.fields("ClientPhonetype") = .fields("ClientPhoneType").Value
      loccode = 4
    rststats.fields("Phonenumber") = .fields("Phonenumber").Value
      loccode = 5
    rststats.fields("CreatedBy") = .fields("CreatedBy").Value
      loccode = 6
    rststats.fields("CreatedDate") = .fields("CreatedDate").Value
      loccode = 7
    rststats.fields("UpdatedBy") = .fields("UpdatedBy").Value
      loccode = 8
    rststats.fields("UpdatedDate") = .fields("Updateddate").Value
      loccode = 9
    rststats.update
    
    End If
    
    rststats.Close
    Set rststats = Nothing
    totalcnt = totalcnt + 1
    On Error GoTo Phone_error_Handler
movenext:
    .movenext
    Loop

End With


    textt = "Updated " & totalcnt & " total records"
    typeloc = "client phones" + Location
    WriteHistory "Add/Update Records", typeloc, 0, 0, textt
exitfunction:
    On Error Resume Next
    rststats.Close
    Set rststats = Nothing
    rstdownloaded.Close
    Set rstdownloaded = Nothing
Exit Function

Phone_error_Handler:

    If loccode > 0 Then
    
        myerr = Err
        myerrdescr = Err.Description
        textt = "Clientnumber=" + Str(myclientnbr) + "  err=" + myerr + " myerrdescr=" + myerrdescr + " loccode=" + Str(loccode)
        WriteHistory "Add/Update Phone", typeloc, 0, 0, textt
        Resume Next
        End If
  
   textt = "Error in loading Phone records.  Err = " & Err & "  Description = " & Err.Description & "  " & Str(ClientNumber) + "," + clientphonenbr + "," + clientPhoneType

  
   WriteHistory "Update Records ERROR!!!!!!!", "Client Phone", 0, 0, textt
   Call SendERRORemail(textt)
   GoTo exitfunction
  
      
End Function

This post has been edited by theDBguy: May 23 2020, 06:51 PM
Reason for edit: Added code tags
Go to the top of the page
 
tina t
post May 23 2020, 01:17 PM
Post#10



Posts: 6,616
Joined: 11-November 10
From: SoCal, USA


hi Bob, thanks for posting the code. i looked through it, but i'm finding it hard to follow, partly due to everything being inline (posting it in a code box might have helped with that), and also i'm not familiar with ADO so i'm not sure if that's contributing to my confusion. with one small exception, i think it better to wait to see if David - or anybody else with more experience - will take a whack at this. since it's a holiday weekend, maybe not until next week...

the one small exception is this line i noticed, as

Dim RecordCreation, RecordUpdate As Date

i think that RecordCreation is being dimmed as a Variant data type, not a Date data type. if that's what you intended, sorry - i'm just used to seeing the full declaration for each variable. also, if i'm wrong about the data type, i'm sure somebody will correct me. :)

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
projecttoday
post May 23 2020, 06:41 PM
Post#11


UtterAccess VIP
Posts: 12,246
Joined: 10-February 04
From: South Charleston, WV


Re:
QUOTE
posting it in a code box might have helped with that

CODE
Function AddEditPhone()
Dim i As Long

Dim Comments As String
Dim textt As String
Dim totalcnt As Integer
Dim ClientNumber As Long
Dim ClientPhoneNumber As String
Dim clientPhoneType As String
Dim AdmissionNumber As Long
Dim DischargeNumber As Long
Dim Screeningdate As Date
Dim FollowupNumber As Long
Dim update As Boolean
Dim RecordCreation, RecordUpdate As Date
Dim fieldname As String
Dim typeloc As String
Dim loccode As Integer
Dim myerr As String
Dim myerrdescr As String
Dim myclientnbr As Long


' Delete leftover imported tables
On Error Resume Next
' CurrentDb.TableDefs.Delete ("CMBHSAuthenticationHeader")
' CurrentDb.TableDefs.Delete ("Client")
' CurrentDb.TableDefs.Delete ("ClientContact")
' CurrentDb.TableDefs.Delete ("Comment")
' CurrentDb.TableDefs.Delete ("OrganizationClient")
' CurrentDb.TableDefs.Delete ("ServiceError")

i = DeleteAllRecords("CMBHSAuthenticationHeader")
i = DeleteAllRecords("Client")
i = DeleteAllRecords("clientcontact")
i = DeleteAllRecords("comment")
i = DeleteAllRecords("organizationclient")
i = DeleteAllRecords("serviceerror")



On Error GoTo Phone_error_Handler




Set rstdownloaded = New ADODB.Recordset
'Set rststats = New ADODB.Recordset
totalcnt = 0
update = False
rstdownloaded.Open ("SELECT * FROM ClientPhone"), CurrentProject.Connection, adOpenKeyset, , adCmdText
With rstdownloaded


Do Until .eof
loccode = 0
ClientNumber = 1000000000 + Val(.fields("clientNbr"))
myclientnbr = ClientNumber


ClientPhoneNumber = .fields("clientphonenbr")
clientPhoneType = .fields("clientphonetype")

'*** added 5/22/2012 To resolve occasional error ****
On Error Resume Next
rststats.Close
Set rststats = Nothing
Set rststats = New ADODB.Recordset
On Error GoTo Phone_error_Handler

'*****************************************************

rststats.Open ("Select * FROM tbl_clientPhone " & _
" WHERE [clientphonenbr] = '" & ClientPhoneNumber & "'" & "and [clientphonetype] = '" & clientPhoneType & "'" & _
" and [clientnbr] = " & Str(ClientNumber)), _
CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTableDirect

If Not rststats.eof Then
If Val(ClientNumber) <> Val(rststats.fields("clientnbr")) Then

textt = DataFile & " Client numbers do not match - - downloaded client_number = " & rstdownloaded.fields("clientnbr") & " database client number = " & rststats.fields("client_number") & "Change not made."

WriteHistory "Update Records ERROR!!!!!!!", "ClientPhone", 0, 0, textt
Call SendERRORemail(textt)
rststats.Close
Set rststats = Nothing
GoTo movenext
End If


'''''RSTstats.Edit This is only used in DAO not in ADO which is what I am using

Else

rststats.AddNew

End If
On Error GoTo Phone_error_Handler

If IsNull(rststats.fields("UpdatedDate")) Or .fields("Updateddate").Value > rststats.fields("UpdatedDate") Then

loccode = 1
rststats.fields("ClientPhoneNbr") = .fields("ClientPhonenbr").Value
loccode = 2
rststats.fields("ClientNbr") = ClientNumber
loccode = 3
rststats.fields("ClientPhonetype") = .fields("ClientPhoneType").Value
loccode = 4
rststats.fields("Phonenumber") = .fields("Phonenumber").Value
loccode = 5
rststats.fields("CreatedBy") = .fields("CreatedBy").Value
loccode = 6
rststats.fields("CreatedDate") = .fields("CreatedDate").Value
loccode = 7
rststats.fields("UpdatedBy") = .fields("UpdatedBy").Value
loccode = 8
rststats.fields("UpdatedDate") = .fields("Updateddate").Value
loccode = 9
rststats.update

End If

rststats.Close
Set rststats = Nothing
totalcnt = totalcnt + 1
On Error GoTo Phone_error_Handler
movenext:
.movenext
Loop

End With


textt = "Updated " & totalcnt & " total records"
typeloc = "client phones" + Location
WriteHistory "Add/Update Records", typeloc, 0, 0, textt
exitfunction:
On Error Resume Next
rststats.Close
Set rststats = Nothing
rstdownloaded.Close
Set rstdownloaded = Nothing
Exit Function

Phone_error_Handler:

If loccode > 0 Then

myerr = Err
myerrdescr = Err.Description
textt = "Clientnumber=" + Str(myclientnbr) + " err=" + myerr + " myerrdescr=" + myerrdescr + " loccode=" + Str(loccode)
WriteHistory "Add/Update Phone", typeloc, 0, 0, textt
Resume Next
End If

textt = "Error in loading Phone records. Err = " & Err & " Description = " & Err.Description & " " & Str(ClientNumber) + "," + clientphonenbr + "," + clientPhoneType


WriteHistory "Update Records ERROR!!!!!!!", "Client Phone", 0, 0, textt
Call SendERRORemail(textt)
GoTo exitfunction


End Function

--------------------
Robert Crouser
Go to the top of the page
 
tina t
post May 23 2020, 08:40 PM
Post#12



Posts: 6,616
Joined: 11-November 10
From: SoCal, USA


hi Robert, and thanks, but i'm only assuming that Bob indents his code in the VBE. pasting it as straight text in UA loses that formatting. copying the straight text into a code box doesn't restore the original layout; your posted copy of the code looks just like Bob's posted code.

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
projecttoday
post May 23 2020, 09:05 PM
Post#13


UtterAccess VIP
Posts: 12,246
Joined: 10-February 04
From: South Charleston, WV


Okay. I'm sorry for that.


--------------------
Robert Crouser
Go to the top of the page
 
theDBguy
post May 23 2020, 11:52 PM
Post#14


UA Moderator
Posts: 78,155
Joined: 19-June 07
From: SunnySandyEggo


I added the code tags to the original post. Hope that helps...

--------------------
Just my 2 cents... "And if I claim to be a wise man, it surely means that I don't know" - Kansas
Access Website | Access Blog | Email
Go to the top of the page
 
tina t
post May 24 2020, 10:00 AM
Post#15



Posts: 6,616
Joined: 11-November 10
From: SoCal, USA


DBguy, thank you! :) tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
cheekybuddha
post May 25 2020, 09:01 AM
Post#16


UtterAccess Moderator
Posts: 12,856
Joined: 6-December 03
From: Telegraph Hill


Hi,

Just flying by, so haven't had time to digest all that code.

Since you are using ADODB recordsets, you can test that they are open before trying to close them:
CODE
' ...
    '*** added 5/22/2012 To resolve occasional error ****
'    On Error Resume Next
'    rststats.Close
'    Set rststats = Nothing
'    Set rststats = New ADODB.Recordset
'    On Error GoTo Phone_error_Handler
    If rststats.State = adStateOpen Then
      rststats.Close
    End If
' ...

Repeat for each instance.

I will need to look at this in more detail (no time at the moment frown.gif ), but I wouldn't be surprised if you could replace all of that code with a single query.

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    6th June 2020 - 01:54 AM