When we process an invoice, we transmit it to the taxman by the way of an API and then when accepted by the taxman server, the server responds by sending back a Json string like below:
Now what is required are two tasks here, see below:
(1) Grab the necessary fields from the above Json string (resultDt":"20240215163104","rcptNo":35,"intrlData":"6IIIJLJODOKTAIN3ZUEDODJ74A",and "rcptSign":"RTWRWAMJJFHL5RT2"
(2) The above fields must be part of the invoice header, the challenge here is how to update a particular invoice with parameter InvoiceID with the received new fields.
My scant VBA Code Looks like below:
'Processing data from the string above
Set db = CurrentDb
Set rs = db.OpenRecordset("tblInvoice", dbOpenDynaset)
Set Json = JsonConverter.ParseJson(strDataAudit)
'Process data.
Z = 1
There is still an error on the Json received Type Mistmach
For Each Details In Json ' with Me.InvoiceID ' This is the reference required to direct the below details where they are required to be updated
rs.AddNew
rs![ReceiptNo] = Details("rcptNo")
rs![intrlData] = Details("intrlData")
rs![rcptSign] = Details("rcptSign")
rs![vsdcRcptPbctDate] = Details("vsdcRcptPbctDate")
rs![FiscalCode] = Details("FiscalCode")
rs.Update
Z = Z + 1
Next
rs.Close
Set rs = Nothing
Set db = Nothing
Set Json = Nothing
Set Details = Nothing
Code:
{"resultCd":"000","resultMsg":"It is succeeded","resultDt":"20240215163104","data":{"rcptNo":35,"intrlData":"6IIIJLJODOKTAIN3ZUEDODJ74A","rcptSign":"RTWRWAMJJFHL5RT2","totRcptNo":35,"vsdcRcptPbctDate":"20240215163104","sdcId":"SDC0060000005","mrcNo":"WIS00000006 "}}
Now what is required are two tasks here, see below:
(1) Grab the necessary fields from the above Json string (resultDt":"20240215163104","rcptNo":35,"intrlData":"6IIIJLJODOKTAIN3ZUEDODJ74A",and "rcptSign":"RTWRWAMJJFHL5RT2"
(2) The above fields must be part of the invoice header, the challenge here is how to update a particular invoice with parameter InvoiceID with the received new fields.
My scant VBA Code Looks like below:
'Processing data from the string above
Set db = CurrentDb
Set rs = db.OpenRecordset("tblInvoice", dbOpenDynaset)
Set Json = JsonConverter.ParseJson(strDataAudit)
'Process data.
Z = 1
There is still an error on the Json received Type Mistmach
Code:
Public Sub CmdCwrite_Click()
Call CmdTotalClasses_Click
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Company As New Dictionary
Dim strData As String
Dim Json As Object
Dim data As New Dictionary
Dim transactions As Collection
Dim itemCount As Long
Dim Details As Variant
Dim strDataAudit As String
Dim i As Long
Dim n As Integer
Dim Z As Integer
Dim item As New Dictionary
Dim items As New Collection
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
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 data = New Dictionary
Set transactions = New Collection
Set Company = New Dictionary
Company.Add "tpin", "1002623668"
Company.Add "bhfId", "000"
Company.Add "invcNo", rs!InvoiceID.value
Company.Add "orgInvcNo", Nz(rs!OrignalInvoiceNumber.value, 0)
Company.Add "custTpin", rs!TPIN.value
Company.Add "custNm", rs!Company.value
Company.Add "salesTyCd", "N"
Company.Add "rcptTyCd", "S"
Company.Add "pmtTyCd", "01"
Company.Add "salesSttsCd", "02"
Company.Add "cfmDt", Now()
Company.Add "salesDt", Format((Date), "YYYYMMDD")
Company.Add "stockRlsDt", Now()
Company.Add "cnclReqDt", Null
Company.Add "cnclDt", Null
Company.Add "rfdDt", Null
Company.Add "rfdRsnCd", Null
Company.Add "totItemCnt", Me.txtinternalaudit
Company.Add "taxblAmtA", Round(Nz(Me.txtclassA, 0), 2)
Company.Add "taxblAmtB", Round(Nz(Me.txtclassB, 0), 2)
Company.Add "taxblAmtC1", Round(Nz(Me.txtclassC1, 0), 2)
Company.Add "taxblAmtC2", Round(Nz(Me.txtclassC2, 0), 2)
Company.Add "taxblAmtC3", Round(Nz(Me.txtclassC3, 0), 2)
Company.Add "taxblAmtD", Round(Nz(Me.txtclassD, 0), 2)
Company.Add "taxblAmtRvat", 0
Company.Add "taxblAmtE", 0
Company.Add "taxblAmtF", 0
Company.Add "taxblAmtIpl1", 0
Company.Add "taxblAmtIpl2", 0
Company.Add "taxblAmtTl", 0
Company.Add "taxblAmtEcm", 0
Company.Add "taxblAmtExeeg", 0
Company.Add "taxblAmtTot", 0
Company.Add "taxRtA", Nz((rs!Tax.value) * 100, 0)
Company.Add "taxRtB", Nz((rs!Tax.value) * 100, 0)
Company.Add "taxRtC1", 0
Company.Add "taxRtC2", 0
Company.Add "taxRtC3", 0
Company.Add "taxRtD", 0
Company.Add "taxRtE", 0
Company.Add "taxRtF", 0
Company.Add "taxRtIpl1", 0
Company.Add "taxRtIpl2", 0
Company.Add "taxRtTl", 0
Company.Add "taxRtEcm", 0
Company.Add "taxRtExeeg", 0
Company.Add "taxRtTot", 0
Company.Add "taxRtRvat", 0
Company.Add "taxAmtA", Round(Nz(Me.txtttaxclassA, 0), 2)
Company.Add "taxAmtB", Round(Nz(Me.txtttaxclassb, 0), 2)
Company.Add "taxAmtC1", 0
Company.Add "taxAmtC2", 0
Company.Add "taxAmtC3", 0
Company.Add "taxAmtD", 0
Company.Add "taxAmtE", 0
Company.Add "taxAmtF", 0
Company.Add "taxAmtIpl1", 0
Company.Add "taxAmtIpl2", 0
Company.Add "taxAmtTl", 0
Company.Add "taxAmtEcm", 0
Company.Add "taxAmtExeeg", 0
Company.Add "taxAmtTot", 0
Company.Add "taxAmtRvat", 0
Company.Add "totTaxblAmt", Round(Nz(Me.txttotaxableAB, 0), 2)
Company.Add "totTaxAmt", Round(Nz(Me.txttotaltaxAll, 0), 2)
Company.Add "totAmt", Round(Nz(Me.txtGrandtotal, 0), 2)
Company.Add "prchrAcptcYn", "N"
Company.Add "remark", rs!TheNotes.value
Company.Add "regrId", "11999"
Company.Add "regrNm", rs!Cashier.value
Company.Add "modrId", "45678"
Company.Add "modrNm", rs!Cashier.value
Company.Add "receipt", data
data.Add "custMblNo", Null
data.Add "trdeNm", rs!Company.value
data.Add "adrs", rs!Address.value
data.Add "topMsg", ""
data.Add "btmMsg", "Thank you for choosing us"
data.Add "prchrAcptcYn", "N"
Company.Add "itemList", transactions
'--- loop over all the items
itemCount = Me.txtinternalaudit
For i = 1 To itemCount
Set item = New Dictionary
transactions.Add item
item.Add "itemSeq", i
item.Add "itemCd", rs!itemCd.value
item.Add "itemClsCd", rs!itemClsCd.value
item.Add "itemNm", rs!ProductName.value
item.Add "bcd", Null
item.Add "pkgUnitCd", "NT"
item.Add "pkg", 1
item.Add "qtyUnitCd", "U"
item.Add "qty", rs!Quantity.value
item.Add "prc", rs!UnitPrice.value
item.Add "splyAmt", rs!UnitPrice.value
item.Add "dcRt", 0
item.Add "dcAmt", 0
item.Add "isrccCd", Null
item.Add "isrccNm", Null
item.Add "isrcRt", Null
item.Add "isrcAmt", Null
item.Add "vatCatCd", rs!TaxClassA.value
item.Add "iplCatCd", "IPL1"
item.Add "tlCatCd", "TL"
item.Add "exciseCatCd", "EXEEG"
item.Add "taxblAmt", Round(rs!SupplierAmount.value, 2)
item.Add "vatAmt", Round(rs!FinalTax.value, 2)
item.Add "iplAmt", Null
item.Add "tlAmt", Null
item.Add "exciseAmt", Null
item.Add "totAmt", Round(rs!TotalAmount.value, 2)
strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)
rs.MoveNext
Next
Loop
Dim Request As Object
Dim stUrl As String
Dim Response As String
Dim requestBody As String
stUrl = "http://localhost:8080/zrasandboxvsdc/trnsSales/saveSales"
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"
strDataAudit = Request.responsetext
Set rs = db.OpenRecordset("select * FROM [tblCustomerInvoice] WHERE [InvoiceID] = " & Me.txtJsonReceived, dbOpenDynaset)
Set Json = JsonConverter.ParseJson(strDataAudit)
'Process data.
Z = 1
If Not rs.EOF Then
rs.Edit
rs![ReceiptNo] = Details("rcptNo")
rs![intrlData] = Details("intrlData")
rs![rcptSign] = Details("rcptSign")
rs![vsdcRcptPbctDate] = Details("vsdcRcptPbctDate")
rs.Update
Z = Z + 0
Set qdf = Nothing
Set prm = Nothing
End If
End If
End Sub
For Each Details In Json ' with Me.InvoiceID ' This is the reference required to direct the below details where they are required to be updated
rs.AddNew
rs![ReceiptNo] = Details("rcptNo")
rs![intrlData] = Details("intrlData")
rs![rcptSign] = Details("rcptSign")
rs![vsdcRcptPbctDate] = Details("vsdcRcptPbctDate")
rs![FiscalCode] = Details("FiscalCode")
rs.Update
Z = Z + 1
Next
rs.Close
Set rs = Nothing
Set db = Nothing
Set Json = Nothing
Set Details = Nothing
Last edited: