Solved How to grab fields from Json string to be part of the invoice

nector

Member
Local time
Today, 21:39
Joined
Jan 21, 2020
Messages
462
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:

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

ERROR IN PASTING JSON.png

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:
So, what happens when you run that code? Are you getting an error message?
 
> how to update
If you want to update, you should .Edit, not .AddNew.
And first you may want to put the recordset pointer to the desired InvoiceID. I would do that by restricting the recordset to 1 record:
Set rs = db.OpenRecordset("select * from tblInvoice where InvoiceID = " & Me.txtInvoiceID, dbOpenDynaset)
if not rs.EOF
rs.Edit
 
Write
Debug.Print TypeName(Details("rcptNo"))
Before
rs![ReceiptNo] = Details("rcptNo")

Let me know what it says in the immediate window, or show the JSON.
 
Write
Debug.Print TypeName(Details("rcptNo"))
Before
rs![ReceiptNo] = Details("rcptNo")

Let me know what it says in the immediate window, or show the JSON.
The JSON was quoted in the original post.
 
Code:
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("data")("rcptNo")
rs![intrlData] = Details("data")("intrlData")
rs![rcptSign] = Details("data")("rcptSign")
rs![vsdcRcptPbctDate] = Details("data")("vsdcRcptPbctDate")
rs![FiscalCode] = Details("data")("FiscalCode") '????
rs.Update

By the way, OP, why are you using a for each here? do you have many of those JSON strings? maybe it looks like this?
Code:
{
  "someParentKey": [
      {
    "resultCd": "000",
    "resultMsg": "It is succeeded",
    "resultDt": "20240215163104",
    "data": {
      "rcptNo": 35,
      "intrlData": "6IIIJLJODOKTAIN3ZUEDODJ74A",
      "rcptSign": "RTWRWAMJJFHL5RT2",
      "totRcptNo": 35,
      "vsdcRcptPbctDate": "20240215163104",
      "sdcId": "SDC0060000005",
      "mrcNo": "WIS00000006  "
    },
          {
    "resultCd": "another",
    "resultMsg": "another",
    "resultDt": "another",
    "data": {
      "rcptNo": 123123,
      "intrlData": "something",
      "rcptSign": "something",
      "totRcptNo": 123123,
      "vsdcRcptPbctDate": "123123123",
      "sdcId": "asdasdasd",
      "mrcNo": "asdasdasd"
    },
    ...
    ]
  }
}
 
Dear Edgar & Others

Many thanks for your variable help, I promise after the Tax workshop todays I will use the information provided to me, especially that one for Edgar, I do not see it how it will fail.

Regards

Nector
 
Code:
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("data")("rcptNo")
rs![intrlData] = Details("data")("intrlData")
rs![rcptSign] = Details("data")("rcptSign")
rs![vsdcRcptPbctDate] = Details("data")("vsdcRcptPbctDate")
rs![FiscalCode] = Details("data")("FiscalCode") '????
rs.Update

By the way, OP, why are you using a for each here? do you have many of those JSON strings? maybe it looks like this?
Code:
{
  "someParentKey": [
      {
    "resultCd": "000",
    "resultMsg": "It is succeeded",
    "resultDt": "20240215163104",
    "data": {
      "rcptNo": 35,
      "intrlData": "6IIIJLJODOKTAIN3ZUEDODJ74A",
      "rcptSign": "RTWRWAMJJFHL5RT2",
      "totRcptNo": 35,
      "vsdcRcptPbctDate": "20240215163104",
      "sdcId": "SDC0060000005",
      "mrcNo": "WIS00000006  "
    },
          {
    "resultCd": "another",
    "resultMsg": "another",
    "resultDt": "another",
    "data": {
      "rcptNo": 123123,
      "intrlData": "something",
      "rcptSign": "something",
      "totRcptNo": 123123,
      "vsdcRcptPbctDate": "123123123",
      "sdcId": "asdasdasd",
      "mrcNo": "asdasdasd"
    },
    ...
    ]
  }
}
I have now run out of ideas I thought this was straight forward but its proving me wrong, where do I go wrong people here?




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 = ParseJson(Request.responseText)
'Process data.
Z = 1
For Each Details In Json
rs.Edit
rs("rcptNo") = Details("data")("rcptNo")
rs("intrlData") = Details("data")("intrlData")
rs("rcptSign") = Details("data")("rcptSign")
rs("vsdcRcptPbctDate") = Details("data")("vsdcRcptPbctDate")
rs.Update
Z = Z + 0
Next
Set qdf = Nothing
Set prm = Nothing
End If
End Sub


ERROR IN PASTING JSON.png
 
I have just pulled the new data for the new invoice see below and those are the fields I want to get

Code:
{
   "resultCd":"000",
   "resultMsg":"It is succeeded",
   "resultDt":"20240216140952",
   "data":{
      "rcptNo":46,
      "intrlData":"POU3AZEJOOKDQGV5PCMV7QS4WM",
      "rcptSign":"4XROFWQIRZ3L4OIB",
      "totRcptNo":46,
      "vsdcRcptPbctDate":"20240216140952",
      "sdcId":"SDC0060000005",
      "mrcNo":"WIS00000006  "
   }
}
 
If the result of:
Java:
With Request
    .Open "POST", stUrl, False
    .setRequestHeader "Content-type", "application/json"
    .send requestBody
    Response = .responseText
End With

Is just this:
JSON:
{
   "resultCd":"000",
   "resultMsg":"It is succeeded",
   "resultDt":"20240216140952",
   "data":{
      "rcptNo":46,
      "intrlData":"POU3AZEJOOKDQGV5PCMV7QS4WM",
      "rcptSign":"4XROFWQIRZ3L4OIB",
      "totRcptNo":46,
      "vsdcRcptPbctDate":"20240216140952",
      "sdcId":"SDC0060000005",
      "mrcNo":"WIS00000006  "
   }
}

Then a for each loop is not necessary. Use for each loops if you have arrays ob objects. The JSON string you are showing is a single object, not an array, so this would suffice:
Java:
    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 = ParseJson(Request.responseText)
        'Process data.
        Z = 1 ' I don't know what this is for
        rs.Edit
        rs("rcptNo") = Json("data")("rcptNo")
        rs("intrlData") = Json("data")("intrlData")
        rs("rcptSign") = Json("data")("rcptSign")
        rs("vsdcRcptPbctDate") = Json("data")("vsdcRcptPbctDate")
        rs.Update
        Z = Z + 0 ' I don't know what this is for
        Set qdf = Nothing
        Set prm = Nothing
    End If
 
Good Mr Edgar

Many thanks to you sir ,truly you are a genius ,we have struggled a lot for days without any success on this one, this site luck to have such high quality programmers.

Regards

Nector
 
I'm glad to help, nector. Thank you for the nice words, I really appreciate it.
 

Users who are viewing this thread

Back
Top Bottom