将 Excel 数据转换为 JSON，然后将其发布到 API [英] Convert Excel data to JSON then Post it to API

问题描述

我一直在使用以下代码将数据转换为 Json 格式，然后发布/添加到 API 端点.

I have been using this below code which converts the data into Json format then post/add to API end points.

但是它不起作用，没有发生错误.但数据不会发送到 API.非常感谢您的帮助.

But its not working, there is no error occurs. But data is not sent to API. your help will be much appreciated.

我真的不知道错误在哪里发生它很好地将数据转换为json但是为什么它没有发布到API.当看到时，API 响应为空.

I really do not know where the mistake is occurs it converts the data well into json but why it does not post to API. and API response comes empty when see.

Option Explicit

Sub ConvertAndSend()
    Dim apiJSON As String
    apiJSON = ConvertJSON
    
    Dim apiResponse As String
    apiResponse = httpPost("put in api endpoint url", apiJSON)
End Sub

Function ConvertJSON() As String
    
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
            
    Dim lcolumn As Long
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim lrow As Long
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    
    Dim titles() As String
    ReDim titles(lcolumn)
    Dim i As Long
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
    
    Dim json As String
    json = "["
    
    Dim dq As String
    
    dq = """"
    
    Dim j As Long
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                json = json & "{"
            End If
            
            Dim cellvalue As Variant 'or declare as String
            cellvalue = wks.Cells(j, i)
            json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                json = json & ","
            End If
        Next i
        json = json & "}"
        If j <> lrow Then
            json = json & ","
        End If
    Next j
    ConvertJSON = json & "]"
End Function

Function httpPost(url As String, msg As String) As String
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", url, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"    'Don't think it's necessary
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"   'Consult API documentation on the required Content-Type
        '.setRequestHeader "secret-pass-key", "your-key"    <--if needed
        .send msg
        httpPost = .responseText
    End With
End Function

推荐答案

基于 JSON 示例，该 API 似乎一次只接受 1 行数据，因此您必须构建一个 JSON 字符串并发送到API 一次一行.

Based on the JSON sample, it seems that the API only accept 1 row of data at a time so you will have to build a JSON string and send to the API one row at a time.

1. 由于示例 JSON 在开始和结束时没有 [] 括号，因此您需要将其删除.
2. sku、uniqueID 和 epid 值使用的是未用 "括起来的数值." 所以你也需要删除它们.

1. Since the sample JSON does not have a [] bracket at the start and end so you need to remove it.
2. sku, uniqueID and epid values are using a numeric value which are not enclosed with " " so you will need to remove them as well.

我已修改您的代码(或我的?)以生成所需的格式.运行 ConvertAndSend 现在将为一行构建一个 JSON 字符串，然后在循环中将其发送到 API.

I have modify your code (or mine?) to produce the required format. Running ConvertAndSend will now build a JSON string for a row then send it to the API in a loop.

Option Explicit

Private wks As Worksheet
Private lcolumn As Long
Private titles() As String

Private Sub ConvertAndSend()
    Set wks = ThisWorkbook.Sheets(1)
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    
    GetKeys
    
    Dim lrow As Long
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    
    Dim i As Long
    Dim apiJSON As String
    Dim apiResponse As String
    For i = 2 To lrow
        apiJSON = ConvertJSON(i)
        apiResponse = httpPost("API Endpoint URL", apiJSON)
        Debug.Print apiResponse
    Next i
End Sub

Private Sub GetKeys()
    ReDim titles(lcolumn) As String
    Dim i As Long
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
End Sub

Function ConvertJSON(argRow As Long) As String
    Dim dq As String
    dq = Chr(34)

    Dim json As String
    json = "{"
        
    Dim j As Long
    For j = 1 To lcolumn
    
        Select Case titles(j)
            Case "sku", "uniqueID", "epid"
                json = json & dq & titles(j) & dq & ":" & wks.Cells(argRow, j).Value2
            Case Else
                json = json & dq & titles(j) & dq & ":" & dq & wks.Cells(argRow, j).Value2 & dq
        End Select
        
        If j <> lcolumn Then json = json & ","
    Next j
    
    ConvertJSON = json & "}"
End Function

Function httpPost(url As String, msg As String) As String
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", url, False
        .setRequestHeader "Content-type", "application/json"
        .send msg
        httpPost = .responseText
    End With
End Function

如果代码看起来乱七八糟，我深表歉意，如果 API 响应仍然相同(验证错误)，那么我相信您给它的值是不可接受的，我们无法提供帮助你用这个.

I do apologise if the code looks messy as it's late at my area, if the API response is still the same (validation error) then I believe the value you are giving it to is not acceptable which we have no way to help you with this.

这篇关于将 Excel 数据转换为 JSON，然后将其发布到 API的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！