user14286902
user14286902

Reputation:

Convert Excel data to JSON then Post it to API

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

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

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

Upvotes: 0

Views: 481

Answers (1)

Raymond Wu
Raymond Wu

Reputation: 3387

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. 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.

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

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.

Upvotes: 1

Related Questions