I have this code below which I developed in Ms Access VBA to prepare the data for posting after converting it into Json . If I use the message method I can see the correct converted data , but if try to post nothing happens kindly see how you can help here:
Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
' Const SQL_SELECT As String = "SELECT * FROM Qry1;"
Dim http As Object
Dim coll As VBA.Collection
Dim dict As Scripting.Dictionary
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
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "POST", "http://jsonplaceholder.typicode.com/Invoices,False"
http.send ConvertToJson(coll, Whitespace:=2)
Set db = CurrentDb
Set qdf = db.QueryDefs("Qry1")
For Each prm In qdf.Parameters
prm = Eval(prm.Name)
Next prm
Set rs = qdf.OpenRecordset()
Set qdf = Nothing
Set coll = New VBA.Collection
' Set db = CurrentDb
' Set rs = db.OpenRecordset(SQL_SELECT, dbOpenSnapshot)
If Not rs.BOF And Not rs.EOF Then
Do While Not rs.EOF
Set dict = New Scripting.Dictionary
For Each fld In rs.fields
dict.Add fld.Name, rs.fields(fld.Name).Value
Next fld
coll.Add dict
rs.MoveNext
Loop
End If
rs.Close
Set fld = Nothing
Set rs = Nothing
Set db = Nothing
Set dict = Nothing
MsgBox "Post Success"
Set coll = Nothing
End Sub
nectorprime
commented
4 years ago
I have this code below which I developed in Ms Access VBA to prepare the data for posting after converting it into Json . If I use the message method I can see the correct converted data , but if try to post nothing happens kindly see how you can help here:
Option Compare Database Option Explicit Private Sub CmdSales_Click()
' Const SQL_SELECT As String = "SELECT * FROM Qry1;" Dim http As Object Dim coll As VBA.Collection Dim dict As Scripting.Dictionary 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 Set http = CreateObject("MSXML2.XMLHTTP") http.Open "POST", "http://jsonplaceholder.typicode.com/Invoices,False" http.send ConvertToJson(coll, Whitespace:=2) Set db = CurrentDb Set qdf = db.QueryDefs("Qry1") For Each prm In qdf.Parameters prm = Eval(prm.Name) Next prm Set rs = qdf.OpenRecordset()
Set qdf = Nothing Set coll = New VBA.Collection ' Set db = CurrentDb ' Set rs = db.OpenRecordset(SQL_SELECT, dbOpenSnapshot) If Not rs.BOF And Not rs.EOF Then Do While Not rs.EOF Set dict = New Scripting.Dictionary For Each fld In rs.fields dict.Add fld.Name, rs.fields(fld.Name).Value Next fld
End If
rs.Close Set fld = Nothing Set rs = Nothing Set db = Nothing Set dict = Nothing MsgBox "Post Success" Set coll = Nothing End Sub