使用 VBA 将 json 解析为 MS 访问表时出错

Question

请参阅下面的代码，使用 VBA 将数据从 json 解析到 MS Access table 中。第一级 (Order) 工作正常，第二级 (OrderLine) 出现错误，并且不太确定如何从第一个 table 获取 OrderDetailID（这是一个自动编号）到第二个table 能够link。我一直在使用我在网上找到并复制的一些代码，但有些代码不太正确。我正在使用 Tim Hall VBA-json 解析器。第一个错误是行 rs!OrderDetailID = Order("OrderID") 上的数据类型转换错误。如果我离开那行然后我得到错误错误数量参数或无效属性分配行 arrValues = Split(OrderLine, ",")。非常感谢任何帮助。谢谢

Json 检索到的数据：

{"Order":
[{"ShipLastName":"Bloggs",
"ShipFirstName":"Joe",
"OrderID":"INV1324",
"OrderType":"sales",
"OrderLine":
    [{"Quantity":"1",
    "SKU":"9045200017",
    "OrderLineID":"INV1324-0"}],
"DeliveryInstruction":"",
"ShipPhone":"+6491234567",
"Email":"joe.bloggs@somecompany.com",
"ShippingOption":"Standard Shipping",
"ShipCompany":"Some Company Ltd",
"ShipStreetLine1":"58 Some Street",
"ShipCity":"Some City",
"ShipState":"Some State",
"ShipCountry":"NZ",
"CustomerRef1":"",
"DatePlaced":"2021-06-03 22:26:48",
"OrderStatus":"Pick",
"ShipPostCode":"2103"}],
"CurrentTime":"2021-09-21 05:10:24",
"Ack":"Success"}

    Option Compare Database
    Option Explicit
    Dim arrValues() As String
    Dim I As Integer
    --------------------------
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim JsonText As Object
    Dim Order As Variant
    Dim OrderLine As Variant

    'add order to tblOrderDetails
    Set rs = db.OpenRecordset("tblOrderDetails", dbOpenDynaset, dbSeeChanges)
    Set JsonText = JsonConverter.ParseJson(reader.responseText)
   
    For Each Order In JsonText("Order")
        rs.AddNew
        rs!Date = Format(Now(), "dd/mm/yyyy")
        rs!Time = Format(Now(), "hh:nn")
        rs!ClientID = 123
        rs!OrderNo = Order("OrderID")
        rs!DelPhone = Order("ShipPhone")
        rs!NotifyEmailAddress = Order("Email")
        rs!DelName = Order("ShipCompany")
        rs!DelStreet = Order("ShipStreetLine1")
        rs!DelSuburb = Order("ShipCity")
        rs!DelCity = Order("ShipState")
        rs!DelZipCode = Order("ShipPostCode")
        rs!DelCountryID = DLookup("CountryID", "tblCountries", "CountryCode = '" & Order("ShipCountry") & "'")
        rs!DelContactName = Order("ShipFirstName") & " " & Order("ShipLastName")
        rs.Update
    Next Order
    
    'add products to tblOrdersProd
    Set rs = db.OpenRecordset("tblOrdersProd", dbOpenDynaset, dbSeeChanges)
    
    Set JsonText = JsonConverter.ParseJson(reader.responseText)
        
    For Each Order In JsonText("Order")
        For Each OrderLine In Order("OrderLine")
          rs.AddNew
          rs!OrderDetailID = Order("OrderID")
          arrValues = Split(OrderLine, ",")
          For I = 0 To UBound(arrValues)
             rs!Qty = arrValues(1)
             rs!Productid = DLookup("ProductID", "tblProducts", "ProductCode = '" & OrderLine(arrValues(2)) & "'")
          Next
          rs.Update
       Next OrderLine
    Next Order
    rs.Close

Answer 1

这是我的建议，您可能需要稍微调整一下才能使其正常运行...

Option Compare Database
Option Explicit

'//--------------------------
Dim db As DAO.Database
Dim rsOrderDetails As DAO.Recordset
Dim rsOrdersProd As DAO.Recordset
Dim JsonText As Object
Dim Order As Variant
Dim OrderLine As Variant
Dim newID as Long

'add order to tblOrderDetails
Set rsOrderDetails = db.OpenRecordset("tblOrderDetails", dbOpenDynaset, dbSeeChanges)

'add products to tblOrdersProd
Set rsOrdersProd = db.OpenRecordset("tblOrdersProd", dbOpenDynaset, dbSeeChanges)


Set JsonText = JsonConverter.ParseJson(reader.responseText)

For Each Order In JsonText("Order")
    With rsOrderDetails
        .AddNew
        !Date = Format(Now(), "dd/mm/yyyy")
        !Time = Format(Now(), "hh:nn")
        !ClientID = 123
        !OrderNo = Order("OrderID")
        !DelPhone = Order("ShipPhone")
        !NotifyEmailAddress = Order("Email")
        !DelName = Order("ShipCompany")
        !DelStreet = Order("ShipStreetLine1")
        !DelSuburb = Order("ShipCity")
        !DelCity = Order("ShipState")
        !DelZipCode = Order("ShipPostCode")
        !DelCountryID = DLookup("CountryID", "tblCountries", "CountryCode = '" & Order("ShipCountry") & "'")
        !DelContactName = Order("ShipFirstName") & " " & Order("ShipLastName")
        .Update

        '// Now get the newly-allocated autonumber field
        .Bookmark = .LastModified 
        newID = !OrderDetailID
    End With

    For Each OrderLine In Order("OrderLine")
      With rsOrdersProd
          .AddNew

          '// Use the ID from the OrderDetails record
          !OrderDetailID = newID
     
          !Qty = OrderLine("Quantity")
          !Productid = DLookup("ProductID", "tblProducts", "ProductCode = '" & OrderLine("SKU") & "'")
    
          .Update
      End With
    Next OrderLine

    
Next Order

rsOrderDetails.Close
rsOrdersProd.Close

使用 VBA 将 json 解析为 MS 访问表时出错

error parsing json into MS access tables using VBA

ms-access

parsing

vba

json