Pasting Json data into Ms Access table

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc used Ask the Experts™
on
After working so hard trying the Json stuff I have managed to make it work in Excel without problems, now I want help to make the same to work Ms Access.
I have created a table called CONTACT with the following controls:
•      ID
•      FirstName
•      Username
•      Email
•      Address
•      City
•      Phone
•      Website
•      Company Name
Below is the code that is working very well in excel:
Public Sub exceljson()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "http://jsonplaceholder.typicode.com/users", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
For Each Item In JSON
Sheets(1).Cells(i, 1).Value = Item("id")
Sheets(1).Cells(i, 2).Value = Item("name")
Sheets(1).Cells(i, 3).Value = Item("username")
Sheets(1).Cells(i, 4).Value = Item("email")
Sheets(1).Cells(i, 5).Value = Item("address")("city")
Sheets(1).Cells(i, 6).Value = Item("phone")
Sheets(1).Cells(i, 7).Value = Item("website")
Sheets(1).Cells(i, 8).Value = Item("company")("name")
i = i + 1
Next
MsgBox ("complete")
End Sub

Open in new window


The help I want is to create a query inside the above code so that when I click the button on the form the code can now send the data to the table called CONTACT.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
President / Owner CARDA Consultants Inc.
Distinguished Expert 2018
Commented:
There are numerous ways this can be approached, below is one
Public Sub accessjson()
    Dim http                  As Object
    Dim JSON                  As Object
    Dim i                     As Integer
    Dim db                    As DAO.Database
    Dim rs                    As DAO.Recordset

    Set http = CreateObject("MSXML2.XMLHTTP")
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Contact")
    http.Open "GET", "http://jsonplaceholder.typicode.com/users", False
    http.send
    Set JSON = ParseJson(http.responseText)
    i = 2
    For Each Item In JSON
        '        Sheets(1).Cells(i, 1).Value = Item("id")
        '        Sheets(1).Cells(i, 2).Value = Item("name")
        '        Sheets(1).Cells(i, 3).Value = Item("username")
        '        Sheets(1).Cells(i, 4).Value = Item("email")
        '        Sheets(1).Cells(i, 5).Value = Item("address")("city")
        '        Sheets(1).Cells(i, 6).Value = Item("phone")
        '        Sheets(1).Cells(i, 7).Value = Item("website")
        '        Sheets(1).Cells(i, 8).Value = Item("company")("name")
        With rs
            .AddNew
            ![ID] = Item("id")
            ![Name] = Item("name")
            ![UserName] = Item("username")
            ![Email] = Item("email")
            ![City] = Item("address")("city")
            ![Phone] = Item("phone")
            ![WebSite] = Item("website")
            ![Company Name] = Item("company")("name")
            .Update
        End With
        i = i + 1
    Next
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set JSON = Nothing
    Set http = Nothing

    MsgBox ("complete")
End Sub

Open in new window


You need to add proper error handling, but this should at the very least fully demonstrate the principle.
Thank you so much!

All is fine now!

Regards

Chris

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial