Solved Cleaning Up the recordset after use in MS Access

[nector]

Hi

Surprised I'm experiencing MS Access hanging after using the record set continuously every after-11th Call on the record set, I strongly believe probably I'm not cleaning up the record set properly, see the code below:

Private Sub CmdProductsDetails_Click()

Dim Cancel As Integer
If IsNull(Me.CboProcductDetals) Then
Beep
MsgBox "Please Select the Product name you want to transfer data to smart invoice", vbCritical, "Wrong data"
Cancel = True
Exit Sub
End If
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Company As New Dictionary
Dim strData As String
Dim n As Long
Dim Json As Object
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
Set db = CurrentDb
Set qdf = db.QueryDefs("QrySmartInvoiceProductsDetails")

For Each prm In qdf.Parameters
     prm = Eval(prm.Name)
Next prm
Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
Set Company = New Dictionary
        Company.Add "tpin", rs!TPIN.Value
        Company.Add "bhfId", rs!bhfId.Value
        Company.Add "itemCd", rs!itemCd.Value
        Company.Add "itemClsCd", rs!itemClsCd.Value
        Company.Add "itemTyCd", rs!itemTyCd.Value
        Company.Add "itemNm", rs!ProductName.Value
        Company.Add "itemStdNm", rs!ProductName.Value
        Company.Add "orgnNatCd", rs!orgnNatCd.Value
        Company.Add "pkgUnitCd", rs!pkgUnitCd.Value
        Company.Add "qtyUnitCd", rs!qtyUnitCd.Value
        Company.Add "vatCatCd", "A"
        Company.Add "iplCatCd", "IPL1"
        Company.Add "tlCatCd", "TL"
        Company.Add "exciseCatCd", "ECM"
        Company.Add "btchNo", Null
        Company.Add "bcd", Null
        Company.Add "dftPrc", rs!dftPrc.Value
        Company.Add "addInfo", Null
        Company.Add "sftyQty", Null
        Company.Add "isrcAplcbYn", "N"
        Company.Add "useYn", "Y"
        Company.Add "regrNm", rs!regrNm.Value
        Company.Add "regrId", rs!regrId.Value
        Company.Add "modrNm", rs!modrNm.Value
        Company.Add "modrId", rs!modrId.Value
strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)
rs.MoveNext
Loop

Dim Request As Object
Dim stUrl As String
Dim Response As String
Dim requestBody As String
stUrl = "http://xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
Set Request = CreateObject("MSXML2.XMLHTTP")
requestBody = strData
    With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-type", "application/json"
        .send requestBody
        Response = .responsetext
    End With
If Request.Status = 200 Then
MsgBox Request.responsetext, vbCritical, "Internal Audit Manager"
'Cleanup:
rs.Close
Set db = Nothing
Set rs = Nothing
Set qdf = Nothing
Set prm = Nothing
Set Json = Nothing
Set Company = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "QryCloseProductssentEIS"
MsgBox "Products Or Service Journal Posting successful", vbInformation, "Please Proceed"
Me.CboProcductDetals = ""
Me.CboProcductDetals.Requery
Me.CboProcductDetals.SetFocus
End If
End Sub

 

[Josef P.]

If you would write the code a bit nicer, the structure might be more recognisable.

If Request.Status = 200 Then
MsgBox Request.responsetext, vbCritical, "Internal Audit Manager"
'Cleanup:
rs.Close
Set db = Nothing
Set rs = Nothing
Set qdf = Nothing
Set prm = Nothing
Set Json = Nothing
Set Company = Nothing
DoCmd.SetWarnings False
DoCmd.OpenQuery "QryCloseProductssentEIS"
MsgBox "Products Or Service Journal Posting successful", vbInformation, "Please Proceed"
Me.CboProcductDetals = ""
Me.CboProcductDetals.Requery
Me.CboProcductDetals.SetFocus
End If

With block indent:

If Request.Status = 200 Then
   MsgBox Request.ResponseText, vbCritical, "Internal Audit Manager"
   'Cleanup:
   rs.Close
   Set db = Nothing
   Set rs = Nothing
   Set qdf = Nothing
   Set prm = Nothing
   Set Json = Nothing
   Set Company = Nothing
   DoCmd.SetWarnings False
   DoCmd.OpenQuery "QryCloseProductssentEIS"
   MsgBox "Products Or Service Journal Posting successful", vbInformation, "Please Proceed"
   Me.CboProcductDetals = ""
   Me.CboProcductDetals.Requery
   Me.CboProcductDetals.SetFocus
End If

This means that the recordset should not be closed if Request.status <> 200?
Also the Msgbox should not be displayed?

BTW:

Do While Not rs.EOF
Set Company = New Dictionary
        Company.Add "tpin", rs!TPIN.Value
        ...
        Company.Add "modrId", rs!modrId.Value
strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)
rs.MoveNext
Loop
...

requestBody = strData

If you only ever use the last data record for requestBody, why do you also create a dictionary from the others?

 

[nector]

Okay Josef thanks

So in short you are saying I should do this:

If Request.Status = 200 Then
MsgBox Request.responsetext, vbCritical, "Internal Audit Manager"
ElseIf(Request.status <>200) Then
MsgBox Request.responsetext, vbCritical, "An Error has occurred"
On error resume next

 

[cheekybuddha]

DoCmd.SetWarnings False

Be careful!

You turn off warnings, but you never turn them back on - so you will not see any further error/information messages from Access.

 

[Josef P.]

So in short you are saying I should do this: ...

Actually, I wanted to suggest that you write your code in a more readable way, then you should find such logic errors yourself.

If Request.Status = 200 Then
MsgBox Request.responsetext, vbCritical, "Internal Audit Manager"
ElseIf(Request.status <>200) Then
MsgBox Request.responsetext, vbCritical, "An Error has occurred"
On error resume next

Is that easy for you to read?
Where will End If be?
Can status assume values other than 200 and <> 200? ... if not, then why the elseif?
Should DoCmd.OpenQuery ‘QryCloseProductssentEIS’ always be executed? If not, where will it be in the code?

rs.Close could be executed much earlier.

Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
Set qdf = Nothing
rs.MoveFirst
Do While Not rs.EOF
        Set Company = New Dictionary
        Company.Add "tpin", rs!TPIN.Value
        ...
        Company.Add "modrId", rs!modrId.Value
        strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)

        rs.MoveNext
Loop
rs.close
set rs = nothing

But as already mentioned, you could leave out the whole loop.

Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
Set qdf = Nothing
rs.MoveLast
Set Company = New Dictionary
Company.Add "tpin", rs!TPIN.Value
...
Company.Add "modrId", rs!modrId.Value
rs.close
strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)

This brings the same data into strData. I can't say whether this is how it should be.

 

[nector]

Okay many thanks to you Josef

 

[Pat Hartman]

If Request.Status = 200 Then MsgBox Request.responsetext, vbCritical, "Internal Audit Manager" ElseIf(Request.status <>200) Then MsgBox Request.responsetext, vbCritical, "An Error has occurred" On error resume next

incomplete and poorly formatted.

Leaving Errors off is a recipe for disaster. If you make design changes to an object and close it without saving first, Access will quietly discard your changes and you will never know until the code doesn't work later.

This is the ONE case in my apps where I actually use a macro.

The warnings Off macro turns warnings off and the hourglass on.
The warnings on macro turns warnings on and the hourglass off.

The point of the hourglass is that it keeps you from forgetting that warnings are off because trust me, you do not ever want to make that mistake.

 

[gemma-the-husky]

Be careful!

You turn off warnings, but you never turn them back on - so you will not see any further error/information messages from Access.

I was going to say that. I rarely use .openquery to execute an action query. I would use currentdb.execute, and include error handling. As Pat says I would also include error handling for the whole code block.