VBA API how to return more than 32767 characters

[yits05]

Hello,

I have the below code which calls an API and returns JSON. The JSON is frequently greater than the Excel cell character limit of 32767, and therefore gets cut off when entered into my sheet. I was wondering if there is any way to divide responses that are over 32767 into multiple cells in the row? Many thanks

VBA code:

Public Sub GetCandNotesAPII()

    On Error Resume Next
    Dim jobid As Variant
    Dim Strresponse As String
    Dim candid As String
    Dim i As Long
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim Sheet As Worksheet
For i = 2 To FinalRow
    candid = ThisWorkbook.Sheets("Sheet4").Range("C" & i).Value
    Set Sheet = Sheets("Sheet2")

    Const APIkey = "123456abcdef"

    
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
    Dim text As String
    Dim userid As Variant
    
    rootURL = "https://randomAPIURL.com" & candid & "/activity_feed"
    
    
    With httpReq
        .Open "GET", rootURL, False
        .setRequestHeader "Authorization", "Basic " & EncodeBase64(APIkey)
        .send
        Strresponse = .responseText
        Worksheets("Sheet4").Range("E" & i).Value = Strresponse
        
        
    End With

Next i

    
End Sub

Ideal response if "strresponse" > 32767 characters:

source data

source data

source data

source data

Characters 1-32767

Characters 32767 - end

 

[Kenneth Hobson]

Would a JSON parser meet your needs? If so, insert the BAS file from the JSONLib commented link in this example code.

'http://www.vbaexpress.com/forum/showthread.php?68617-Extracting-data-from-json-api
Sub Test_PAS()
  MsgBox PAS([a2], [b2])
End Sub

'=pas(A2,B2)
Function PAS(origin, destination)
  Dim strUrl As String, dollar As Double, response As String, parsed As Object, httpReq As Object
   
  strUrl = "https://www.streetdirectory.com/api/?mode=journey&output=json&country=sg&q=" & _
    origin & "%20to%20" & destination & "&methods=bustrain&vehicle=both&info=1&date=06/20/2021&time=01:38%20PM"
 
  Set httpReq = CreateObject("MSXML2.XMLHTTP")
  With httpReq
    .Open "GET", strUrl, False
    .Send
  End With
  response = httpReq.ResponseText
  'JSONLib, https://github.com/VBA-tools/VBA-JSON
  Set parsed = JsonConverter.ParseJson(response)
  dollar = parsed("total_data")("tr")
 
  PAS = dollar
End Function

 

[Dan_W]

The JSON parser that Kenneth suggested is extremely useful for dealing with JSON. On the off-chance that you (or someone else on the forum) nonetheless needs a function to split long strings across multiple cells, I wrote the following back when I used to get frustrated the character length limitations. It takes three arguments: (1) the text that you want to split, (2) the number of characters you want to split it at (optional | default: 32760 characters), and (3) the 'spill' direction (optional | default: vertical) , and returns a variant. Given that you seem to be outputing the string to cells on the worksheet, I assumed that you would want the string to spill vertically, but have included the third argument to let you decide (vertical = TRUE, horizontal = FALSE):

Function SplitAtLength(ByVal SourceText As String, Optional ByVal MaxChar As Long = 32760, Optional VerticalSpill As Boolean = True) As Variant
    Dim StringLength As Long, NumberSegments As Single, TempArray() As String
    Dim Counter As Long, SegmentCounter As Long
    StringLength = Len(SourceText)
    NumberSegments = WorksheetFunction.RoundUp(StringLength / MaxChar, 0)
    ReDim TempArray(0 To NumberSegments - 1)
    For Counter = 1 To StringLength Step MaxChar
        TempArray(SegmentCounter) = Mid(SourceText, Counter, MaxChar)
        SegmentCounter = SegmentCounter + 1
    Next
    If VerticalSpill Then
        SplitAtLength = WorksheetFunction.Transpose(TempArray)
    Else
        SplitAtLength = TempArray
    End If
End Function

Hopefully, this will be of use to someone.