Reputation:
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
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.
[]
bracket at the start and end so you need to remove it.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