Solved Insert xml data from responsetext to table in access with VBA

[john_gringo]

I am new to Access and VBA.
I'm POSTing some data using the bellow code I receive an XML response.

Sub POSTreq()
    Dim req As New MSXML2.XMLHTTP60
    Dim reqURL As String
    Dim Db As Database
    Dim Rst As Recordset
    Dim Tbl As String
    Dim restxt As String
    
    Set Db = CurrentDb
    Tbl = "SELECT APOST_NUM.ID, APOST_NUM.TOT_VALUE, APOST_NUM.AP_DATE, APOST_NUM.PH_ID, APOST_NUM.PAR_OK, APOST_NUM.CHK_MET, Singular_Data.NAME, Singular_Data.AFM, Singular_Data.STREET, Singular_Data.STRNUMBER, Singular_Data.CITY, Singular_Data.PHONE1 FROM Singular_Data INNER JOIN APOST_NUM ON Singular_Data.NAME = APOST_NUM.PHARMACY WHERE (((APOST_NUM.AP_DATE)>#19/10/2021#));"

    Set Rst = Db.OpenRecordset(Tbl, 2)
    With Rst
    Do While Not .EOF
     reqURL = "https://mydata-dev.azure-api.net/SendInvoices"
    req.Open "POST", reqURL, False
    req.setRequestHeader "aade-user-id", "YahooTest"
    req.setRequestHeader "Ocp-Apim-Subscription-Key", "ce9fbb3df4eb4a10ac56b6e8120e773c"
      
  
    myData = ""
    myData = "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>"
    myData = myData + "<InvoicesDoc xmlns=""http://www.aade.gr/myDATA/invoice/v1.0"" xsi:schemaLocation=""http://www.aade.gr/myDATA/invoice/v1.0 schema.xsd"" xmlns:icls=""https://www.aade.gr/myDATA/incomeClassificaton/v1.0"" xmlns:ecls=""https://www.aade.gr/myDATA/expensesClassificaton/v1.0"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"

    myData = myData + "  <invoice>"
    myData = myData + "    <issuer>"
    myData = myData + "      <vatNumber>033600949</vatNumber>"
    myData = myData + "      <country>GR</country>"
    myData = myData + "      <branch>0</branch>"
    myData = myData + "    </issuer>"
    myData = myData + "    <counterpart>"
    myData = myData + "      <vatNumber>" & Rst!AFM & "</vatNumber>"
    myData = myData + "      <country>GR</country>"
    myData = myData + "      <branch>0</branch>"
    myData = myData + "      <address>"
    myData = myData + "        <street>ODOS PELATH</street>"
    myData = myData + "        <number>11</number>"
    myData = myData + "        <postalCode>11111</postalCode>"
    myData = myData + "        <city>PERIOXH PELATH</city>"
    myData = myData + "      </address>"
    myData = myData + "    </counterpart>"
    myData = myData + "    <invoiceHeader>"
    myData = myData + "      <series>TIM</series>"
    myData = myData + "      <aa>000152</aa>"
    myData = myData + "      <issueDate>2020-09-30</issueDate>"
    myData = myData + "      <invoiceType>1.1</invoiceType>"
    myData = myData + "      <currency>EUR</currency>"
    myData = myData + "    </invoiceHeader>"
    myData = myData + "    <paymentMethods>"
    myData = myData + "      <paymentMethodDetails>"
    myData = myData + "        <type>5</type>"
    myData = myData + "        <amount>31.00</amount>"
    myData = myData + "        </paymentMethodDetails>"
    myData = myData + "    </paymentMethods>"
    myData = myData + "    <invoiceDetails>"
    myData = myData + "      <lineNumber>10001</lineNumber>"
    myData = myData + "      <netValue>25.00</netValue>"
    myData = myData + "      <vatCategory>1</vatCategory>"
    myData = myData + "      <vatAmount>6.00</vatAmount>"
    myData = myData + "      <incomeClassification>"
    myData = myData + "        <icls:classificationType>E3_561_001</icls:classificationType>"
    myData = myData + "        <icls:classificationCategory>category1_1</icls:classificationCategory>"
    myData = myData + "        <icls:amount>25.00</icls:amount>"
    myData = myData + "        <icls:id>1</icls:id>"
    myData = myData + "      </incomeClassification>"
    myData = myData + "    </invoiceDetails>"
    myData = myData + "    <invoiceSummary>"
    myData = myData + "      <totalNetValue>25.00</totalNetValue>"
    myData = myData + "      <totalVatAmount>6.00</totalVatAmount>"
    myData = myData + "      <totalWithheldAmount>0.00</totalWithheldAmount>"
    myData = myData + "      <totalFeesAmount>0.00</totalFeesAmount>"
    myData = myData + "      <totalStampDutyAmount>0.00</totalStampDutyAmount>"
    myData = myData + "      <totalOtherTaxesAmount>0.00</totalOtherTaxesAmount>"
    myData = myData + "      <totalDeductionsAmount>0.00</totalDeductionsAmount>"
    myData = myData + "      <totalGrossValue>31.00</totalGrossValue>"
    myData = myData + "      <incomeClassification>"
    myData = myData + "        <icls:classificationType>E3_561_001</icls:classificationType>"
    myData = myData + "        <icls:classificationCategory>category1_1</icls:classificationCategory>"
    myData = myData + "        <icls:amount>25.00</icls:amount>"
    myData = myData + "        <icls:id>1</icls:id>"
    myData = myData + "      </incomeClassification>"
    myData = myData + "    </invoiceSummary>"
    myData = myData + "  </invoice>"
    myData = myData + "</InvoicesDoc>"


    req.send myData
    Debug.Print req.responseText
    ParseWiseOwlVideos req.responseText
    .MoveNext
    Loop
    End With

    If req.Status <> 200 Then
        MsgBox req.Status & "-" & req.statusText
        Exit Sub
        End If
    
    Debug.Print tXML
    End Sub

From the following XML response, I need to extract UID and MARK and update table fields. The criteria for the update is <index> number.


<?xml version="1.0" encoding="utf-8"?>
<ResponseDoc xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<response>
<index>1</index>
<invoiceUid>BAC9861A68546E5F7D2E7E0AF052E3F443B5174D</invoiceUid>
<invoiceMark>400001851984363</invoiceMark>
<statusCode>Success</statusCode>
</response>
</ResponseDoc>

Any help will be much appreciated
Regards
Jiannis

 

[arnelgp]

Dim strRespose As String
Dim i As Long
Dim fso As Object, file As Object
Dim sFile As String
Dim db As DAO.Database
Dim idx As Long, UID As String, Mark As String
strResponse = req.ResponseText
i = InStr(1, strResponse, "<response>")
If i Then
   strResponse = Mid$(strResponse, i)
End If
i = InStr(1, strResponse, "</ResponseDoc>")
If i Then
   strResponse = Left$(strResponse, i - 1)
End If

'write to textfile
sFile = Environ$("Temp") & "\test.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
With fso.OpenTextFile(sFile, 2, True)
   .Write strResponse
   .Close
End With

Set file = fso.OpenTextFile(sFile, 1)
Set db = CurrentDb
With file
    Do Until .atendofstream
        s = .readline
        If Intr(1, s, "<index>") Then
            idx = Val(Replace$(Replace$(s, "<index>", ""), "</index>", ""))
        End If
        If Intr(1, s, "<invoiceUid>") Then
            UID = Replace$(Replace$(s, "<invoiceUid>", ""), "</invoiceUid>", "")
        End If
        If Intr(1, s, "<invoiceMark>") Then
            Mark = Replace$(Replace$(s, "<invoiceMark>", ""), "</invoiceMark>", "")
        End If
        If Intr(1, s, "<statusCode>") Then
            'update the table
            db.Execute "update yourTable set UID = '" & UID & "' Mark = '" & Mark & "' where id = " & idx & ";"
            'reset the variables
            idx = 0
            UID = "": Mark = ""
        End If
    Loop
    .Close
End With

 

[john_gringo]

So the idea is to save the responce to file first then open the file and use it to update the table?

 

[arnelgp]

So the idea is to save the responce to file first then open the file and use it to update the table?

yes, only the portion of the response text is saved to the file.
then open the file and read, line by line.

 

[john_gringo]

I appreciate your help arnelgp.
Will try and let you know of the results later........then I can buy you a beer

 

[john_gringo]

Man, you show me the way.

I paste the code inside my code (at the end of the loop after "req.send myData") and I receive the following errors:

1. duplicate declaration in current scope for
Dim DB As DAO.Database
When I put a ' before it I receive the next error as it is already declered

2. sub or function not defined for
"If Intr(1, s, "<index>") Then"
I update it to InStr for every Intr in the code as I realize that this was the issue and the next error occurs

3. I updated the line with the table update SQL to:
db.Execute "update invoices set Invoices.UID =" & UID & "Invoices.MARK = " & Mark & " WHERE (((Invoices.InvID)= " & idx & "));"
and I receive the following error: Too few parameters. Expected 1

It looks that we are so close to the solution but I can't find the error. I do really appreciate your time.

 

[john_gringo]

Also, Can I save the responseText text to a specific folder in C:\

 

[arnelgp]

what is the Datatype of UID and Mark on your table?
if they are Short String:

db.Execute "update invoices set Invoices.UID ='" & UID & "', Invoices.MARK = '" & Mark & "' WHERE ((Invoices.InvID)= " & idx & ");"

 

[john_gringo]

Yes this works
db.Execute "update invoices set Invoices.UID ='" & UID & "', Invoices.MARK = '" & Mark & "' WHERE ((Invoices.InvID)= " & idx & ");"
as UID is a short text and MARK is a number

 

[john_gringo]

Can I save the file to a specific folder instead of temp
Like sFile = Environ$("c:\") & "\test.txt" instead of sFile = Environ$("Temp") & "\test.txt"
It is not seems to work, should i change something else?

 

[john_gringo]

also, the .txt file in the temp folder is empty..???? and there is no update in the table with no error.

Should I add any references?

 

[arnelgp]

you hardcode it:

sFile = "c:\"test.txt"

just make sure you have Write access to the Root folder (C:\).

there is no update in the table with no error.

press F9 on your code to add breakpoint. run your sub/function.
when it stops, press F8 and inspect the value of each variables (idx, UID, mark).
if possible write the values. and compare it latter to your table if
it has a match.
remember we are Updating record and not Inserting New one.

 

[john_gringo]

sFile = "c:\"test.txt"
But this will overwrite the old one I'd like to keep all files

 

[john_gringo]

yes, my friend.....It worked.......
You are awesome........

 

[john_gringo]

***** 5 stars from me..