How to send filtered transactions in the MS Access Combo box with one Click (1 Viewer)

[nector]

We are planning to open a supermarket in a busy place now the tax authority requires us to be sending any prices changes to their office each time we make any changes The reason for this is to ensure that they have record also

The prices changes are sent to the tax authority by using an API shown below which is fine and works ok no issues at all

Problem area

(1) To send the data someone has to select the product in a combo box one by one, the reason for using the combo box is because the API allows one transaction at a time NOT bulk

Question

Is there a way to send the same transaction one after another until all the transactions finishes in the combo box. Here we are trying to eliminate the requirement of stationing someone on the computer to be selecting transaction one by one in the combo box and then keep on clicking send command per each transaction selected.

Is there a way to use VBA to send all the transaction in the combo box by one click instead of asking one person to be selecting one item, second etc and then click send, Imagin you have 1000 items in the combo box selecting one by one surely, it's a pain.

Combo Box

SELECT
    tblProducts.ProductID,
    tblProducts.ProductName,
    tblProducts.itemCd,
    tblProducts.Status
FROM
    tblProducts
WHERE
    (((tblProducts.Status) IS NULL))
ORDER BY
    tblProducts.ProductName;

API that sends data to the tax authority

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", vbInformation, "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", Forms!FrmLogin!txtsuptpin.Value
        Company.Add "bhfId", Forms!FrmLogin!txtbhfid.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", rs!vatCatCd.Value
        Company.Add "iplCatCd", "IPL1"
        Company.Add "tlCatCd", rs!taxAmtTl.Value
        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", Forms!FrmLogin!txtpersoning.Value
        Company.Add "regrId", Forms!FrmLogin!txtpersoning.Value
        Company.Add "modrNm", Forms!FrmLogin!txtpersoning.Value
        Company.Add "modrId", Forms!FrmLogin!txtpersoning.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://localhost:8080/XXXXXXXXXXXXXXXXX"
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, vbInformation, "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"
End If
Me.CboProcductDetals = ""
Me.CboProcductDetals.Requery
End Sub

 

[CJ_London]

Why do you need a combo box? Why not just loop through a recordset the same as the combo rowsource?

Or just loop through your querydef - probably need to to remove the prm

 

[nector]

I have changed a combo box to a list box to allow for selecting all the products at one go and the combined VBA code looks like below, but somehow it does not work. Where do I go wrong

Private Sub CmdSubmitTaxinfor_Click()
Dim varItem As Variant
Dim strWhere As String
Dim i As Integer
 
    ' Check if any items are selected
    If Me.CboProcductDetals.ItemsSelected.Count = 0 Then
        MsgBox "Please select at least one product to send.", vbInformation, "No Invoices Selected"
        Exit Sub
    End If

    ' Loop through all selected items in the list box
    For Each varItem In Me.CboProcductDetals.ItemsSelected
        ' Get the ProductID (assuming it's in the bound column, which is column 0 if Bound Column is 1)
        ' Use .Column(0, varItem) to get the value of the bound column
    Dim selectedProductID As Long
        selectedProductID = Me.CboProcductDetals.Column(0, varItem)

        ' Build the filter condition for the report
        strWhere = "[ProductID] = " & selectedProductID

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", Forms!FrmLogin!txtsuptpin.Value
        Company.Add "bhfId", Forms!FrmLogin!txtbhfid.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", rs!vatCatCd.Value
        Company.Add "iplCatCd", "IPL1"
        Company.Add "tlCatCd", rs!taxAmtTl.Value
        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", Forms!FrmLogin!txtpersoning.Value
        Company.Add "regrId", Forms!FrmLogin!txtpersoning.Value
        Company.Add "modrNm", Forms!FrmLogin!txtpersoning.Value
        Company.Add "modrId", Forms!FrmLogin!txtpersoning.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://localhost:8080/XXXXXXXXXXXXXXXXXXXXXXXX"
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, vbInformation, "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"
End If
Me.CboProcductDetals = ""
Me.CboProcductDetals.Requery

Next varItem
 
    MsgBox "Sending all selected products complete.", vbInformation, "all invoices sent"

End Sub

 

[Minty]

Do you ever walk your code to see what is happening?
Ask yourself where the follow lines output get used:

strWhere = "[ProductID] = " & selectedProductID

At no point are you doing anything with this.

 

[nector]

Do you ever walk your code to see what is happening?
Ask yourself where the follow lines output get used:

strWhere = "[ProductID] = " & selectedProductID

At no point are you doing anything with this.

Sir you are free to correct where you have seen an error many thanks for your contributions , but below is how I'm selecting all the products in the list box

Private Sub CmdSelectitemstosend_Click()
    
    ' Define a variable for the list box
    Dim LstBox As ListBox
    Dim i As Integer
    
    ' Set the variable reference to your specific list box control name
    Set LstBox = Me.CboProcductDetals
    
    ' Loop through all items from the first index (0) to the last
    For i = 0 To LstBox.ListCount - 1
        ' Set the Selected property for the current index to True
        LstBox.Selected(i) = True
    Next i
    
    ' Optional: Provide user feedback
    MsgBox "All " & LstBox.ListCount & " items selected.", vbInformation, "Select All Status"

End Sub

 

[nector]

Do you ever walk your code to see what is happening?
Ask yourself where the follow lines output get used:

strWhere = "[ProductID] = " & selectedProductID

At no point are you doing anything with this.

Here I wanted to filter this query called QrySmartInvoiceProductsDetails now reproduced below that is where I have some challenges:

SELECT tblProducts.bhfId, tblProducts.itemCd, tblProducts.itemTyCd, tblProducts.orgnNatCd, tblProducts.pkgUnitCd, tblProducts.qtyUnitCd, tblProducts.btchNo, tblProducts.isrcAplcbYn, tblProducts.useYn, tblProducts.regrNm, tblProducts.regrId, tblProducts.modrNm, tblProducts.modrId, tblProducts.ProductName, tblProducts.ProductID, tblProducts.WHID, tblProducts.Barcode, tblProducts.itemClsCd, tblProducts.dftPrc, tblProducts.TPIN, tblProducts.vatCatCd, tblProducts.taxAmtTl
FROM tblProducts
WHERE (((tblProducts.ProductID)=[Forms]![frmProducts]![CboProcductDetals]));

 

[Minty]

If you always send all the products you don't need the list box, just use your original query without the parameters to restrict its output and loop through it as @CJ_London suggested.

The process should simply be

1. Open your recordset of ALL product ID's
2. Loop round it.
3. Finish

You already have the loop built but are using it for a single record only in your current process (Again, I don't understand why you have a loop for a single record, but suspect it was code you don't fully understand how it is working).

If you took 5 minutes to walk through your code single stepped, you would see how simple it is.

 

[nector]

If you always send all the products you don't need the list box, just use your original query without the parameters to restrict its output and loop through it as @CJ_London suggested.

The process should simply be

1. Open your recordset of ALL product ID's
2. Loop round it.
3. Finish

You already have the loop built but are using it for a single record only in your current process (Again, I don't understand why you have a loop for a single record, but suspect it was code you don't fully understand how it is working).

If you took 5 minutes to walk through your code single stepped, you would see how simple it is.

Please note that the API that send data is designed to send a single record at a time you cannot send bulk record at one go the answer is NO, only when the first single record is complete only then can you move to the second, third, fourth etc

 

[Minty]

Yes, and your loop sends one record at a time doesn't it?

Please, please, please, step through your code and watch what it does!!!!

Edit: You simply need to move where your loop statement goes to after this line

      Response = .ResponseText
   End With

 

[nector]

Yes, and your loop sends one record at a time doesn't it?

Please, please, please, step through your code and watch what it does!!!!

Edit: You simply need to move where your loop statement goes to after this line

      Response = .ResponseText
   End With

I think from your advice unless I got you wrong am supposed to restructure the code like below so that it gives me the correct formatted product list in Json format , see attached

Private Sub CmdSubmitTaxinfor_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    ' Use a Collection or ArrayList to hold multiple product Dictionaries
    Dim ProductsList As New Collection
    Dim CompanyDict As New Dictionary
    Dim strData As String
      
    ' --- Database Setup ---
    Set db = CurrentDb
    ' Assume QrySmartInvoiceProductsDetails works correctly
    Set rs = db.OpenRecordset("QrySmartInvoiceProductsDetails", dbOpenSnapshot)
  
    If rs.EOF Then
        MsgBox "No products found to send.", vbExclamation
        Exit Sub
    End If

    rs.MoveFirst
    Do While Not rs.EOF
        ' Create a NEW dictionary for each product inside the loop
        Set CompanyDict = New Dictionary
      
        ' --- Populate Dictionary for a single product ---
        CompanyDict.Add "tpin", Forms!FrmLogin!txtsuptpin.Value
        CompanyDict.Add "bhfId", Forms!FrmLogin!txtbhfid.Value
        CompanyDict.Add "itemCd", rs!itemCd.Value
        CompanyDict.Add "itemClsCd", rs!itemClsCd.Value
        CompanyDict.Add "itemTyCd", rs!itemTyCd.Value
        CompanyDict.Add "itemNm", rs!ProductName.Value
        CompanyDict.Add "itemStdNm", rs!ProductName.Value
        CompanyDict.Add "orgnNatCd", rs!orgnNatCd.Value
        CompanyDict.Add "pkgUnitCd", rs!pkgUnitCd.Value
        CompanyDict.Add "qtyUnitCd", rs!qtyUnitCd.Value
        CompanyDict.Add "vatCatCd", rs!vatCatCd.Value
        CompanyDict.Add "iplCatCd", "IPL1"
        CompanyDict.Add "tlCatCd", rs!taxAmtTl.Value
        CompanyDict.Add "exciseCatCd", "ECM"
        CompanyDict.Add "btchNo", Null
        CompanyDict.Add "bcd", Null
        CompanyDict.Add "dftPrc", rs!dftPrc.Value
        CompanyDict.Add "addInfo", Null
        CompanyDict.Add "sftyQty", Null
        CompanyDict.Add "isrcAplcbYn", "N"
        CompanyDict.Add "useYn", "Y"
        CompanyDict.Add "regrNm", Forms!FrmLogin!txtpersoning.Value
        CompanyDict.Add "regrId", Forms!FrmLogin!txtpersoning.Value
        CompanyDict.Add "modrNm", Forms!FrmLogin!txtpersoning.Value
        CompanyDict.Add "modrId", Forms!FrmLogin!txtpersoning.Value
      
        ' --- Add the single product dictionary to the overall list ---
        ProductsList.Add CompanyDict
      
        rs.MoveNext
    Loop
  
    ' --- Convert the ENTIRE list of dictionaries to a JSON array string ---
    ' This will create a string like: [{"tpin": "..."}, {"tpin": "..."}, ...]
    strData = JsonConverter.ConvertToJson(ProductsList, Whitespace:=3)
  
    ' --- HTTP Request Setup (Now Outside the Loop) ---
    Dim Request As Object
    Dim stUrl As String
    Dim Response As String
  
    ' The endpoint likely changes when sending a list instead of a single item
    ' Check your API documentation for the correct endpoint for batch saves.
    ' I am using the existing URL, but be aware this might need adjustment.
    stUrl = "http://localhost:8080/XXXXXXXXXXXXXXXXXXXXXXX"
  
    Set Request = CreateObject("MSXML2.XMLHTTP")
  
    With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-type", "application/json"
        .Send strData ' Send the full JSON array string
        Response = .ResponseText
    End With

    ' --- Handle Response ---
    If Request.Status = 200 Then
        MsgBox "Response from API: " & Request.ResponseText, vbInformation, "Internal Audit Manager"
      
        ' --- Cleanup and Post-Processing ---
      
    Else
        MsgBox "API Request Failed. Status: " & Request.Status & vbCrLf & "Response: " & Request.ResponseText, vbCritical, "Error"
    End If

    ' --- Final Cleanup ---
    rs.Close
    Set db = Nothing
    Set rs = Nothing
    Set Request = Nothing
    Set CompanyDict = Nothing
    ' If you were using a QDF object earlier, ensure it's handled if still in scope
End Sub

 

[CJ_London]

Please note that the API that send data is designed to send a single record at a time you cannot send bulk record at one go the answer is NO, only when the first single record is complete only then can you move to the second, third, fourth etc

We understand that - that is how those API's work. So the question is does your query, when you filter it with prm produce more than one record? If it doesn't then you don't need that loop.

And ' somehow it does not work' does not help us to help you. What does it mean? you get an error? in which case, what line? something else?

You might want to tidy up your indentation so it is clear where loops. for each etc start and end