Avatar of Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.ScFlag for Zambia

asked on 

Cleaning up the VBA Code Before Exit

I would like someone to double check the code below on the cleaning up section whether I'm doing the right thing or not:


Clean up part:


rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set Jsonings = Nothing
    Set transaction = Nothing
    Set transactions = Nothing
    Set json = Nothing
    Set item = Nothing
    Set fld = Nothing
    Set root = Nothing
    Set Tax = Nothing
    Set items = Nothing
    Set Details = Nothing
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)
           
    ' Close communications.
    Call CommClose(intPortID)
    
    If lngStatus = 0 Then
Beep
MsgBox "Please note that the Port is now closed", vbOKOnly, "Now you can proceed"
Else
Beep
MsgBox "Please note that the Port is not closed", vbOKOnly, "Wrong Selection"
End If
Exit_CmdConertJson_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdConertJson_Click
    
End Sub

Open in new window



Full VBA CODE in MS Access


Private Sub CmdConertJson_Click()
On Error GoTo Err_Handler
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim root As Dictionary
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    Dim json As Object
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim Jsonings As Object
    Dim Details As Variant
    Dim s As String
    Dim n As Integer
    Dim Z As Long
    Set root = New Dictionary
    Set transactions = New Collection
    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJson")
    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 transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "PosSoftVersion", "2.0.0.1"
        transaction.Add "PosModel", "Cap-2017"
        transaction.Add "PosSerialNumber", Nz(Me.CboEfds.Column(1), "")
        transaction.Add "IssueTime", Nz(Me.txtjsonDate, "")
        transaction.Add "TransactionType", Nz(Me.txtTransactinvoices.value, "")
        transaction.Add "PaymentMode", Nz(Me.PaymentMode, "")
        transaction.Add "SaleType", Nz(Me.txtSalesDescrp.value, "")
        transaction.Add "LocalPurchaseOrder", Nz(Me.LocalPurchaseOrder, "")
        transaction.Add "Cashier", Nz(Me.Cashier, "")
        transaction.Add "BuyerTPIN", Nz(Me.BuyerTPIN, "")
        transaction.Add "BuyerName", Nz(Me.BuyerName, "")
        transaction.Add "BuyerTaxAccountName", Nz(Me.BuyerTaxAccountName, "")
        transaction.Add "BuyerAddress", Nz(Me.BuyerAddress, "")
        transaction.Add "BuyerTel", Nz(Me.BuyerTel, "")
        transaction.Add "OriginalInvoiceCode", Nz(Me.OrignalInvoiceCode, "")
        transaction.Add "OriginalInvoiceNumber", Nz(Me.OrignalInvoiceNumber, "")
        transaction.Add "Memo", Nz(Me.TheNotes, "")
        '--- loop over all the items
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemId", i
            item.Add "Description", DLookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("BarCode", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("Quantity", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("unitPrice", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
             strTaxes = DLookup("CGControl", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "TaxLabels", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
               If Len(Trim(Nz(DLookup("TaxClassB", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i)), ""))) > 0 Then
               Tax.Add Nz(DLookup("TaxClassB", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i)), "")
               End If
            item.Add "TotalAmount", DLookup("TotalAmount", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction

    intPortID = Forms!frmLogin!txtFinComPort.value
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), "baud=115200 parity=N data=8 stop=1")
    If lngStatus <> 0 Then
        ' Handle error.
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
        Application.Quit
    End If
    
    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)
    
    ' Write data to serial port.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = BuildData(JsonConverter.ConvertToJson(transaction, Whitespace:=3))

    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
        ' Handle error.
        On Error Resume Next
    End If
   
   Pause (5)
    
    ' Read maximum of 2034 bytes from serial port.
    lngStatus = CommRead(intPortID, strData, 2036)
    If lngStatus > 0 Then
    Set rs = db.OpenRecordset("tblEfdReceipts", dbOpenDynaset, dbSeeChanges)
    ElseIf lngStatus < 0 Then
        ' Handle error.
     On Error Resume Next
    End If
       
'Processing data from the string above
    Set db = CurrentDb
        
    Set Jsonings = JsonConverter.ParseJson(Chr(91) & Mid(strData, 8) & Chr(34) & "}" & Chr(93))
     
    'Process data.
    Z = 1
    For Each Details In Jsonings
        rs.AddNew
        rs![EsDTime] = CDate(Format$(Details("ESDTime"), "00/00/00 00:00:00"))
        rs![TerminalID] = Details("TerminalID")
        rs![InvoiceCode] = Details("InvoiceCode")
        rs![InvoiceNumber] = Details("InvoiceNumber")
        rs![FiscalCode] = Details("FiscalCode")
        rs![INVID] = Me.InvoiceID
        rs.Update
        Z = 1 + 1
    Next
   
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set Jsonings = Nothing
    Set transaction = Nothing
    Set transactions = Nothing
    Set json = Nothing
    Set item = Nothing
    Set fld = Nothing
    Set root = Nothing
    Set Tax = Nothing
    Set items = Nothing
    Set Details = Nothing
    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)
           
    ' Close communications.
    Call CommClose(intPortID)
    
    If lngStatus = 0 Then
Beep
MsgBox "Please note that the Port is now closed", vbOKOnly, "Now you can proceed"
Else
Beep
MsgBox "Please note that the Port is not closed", vbOKOnly, "Wrong Selection"
End If
Exit_CmdConertJson_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdConertJson_Click
    
End Sub

Open in new window

Microsoft AccessVBA

Avatar of undefined
Last Comment
Jim Dettman (EE MVE)
ASKER CERTIFIED SOLUTION
Avatar of ste5an
ste5an
Flag of Germany image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
SOLUTION
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
Microsoft Access
Microsoft Access

Microsoft Access is a rapid application development (RAD) relational database tool. Access can be used for both desktop and web-based applications, and uses VBA (Visual Basic for Applications) as its coding language.

226K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo