Bitly API v4 - VBA Excel Macro

Question

I'm trying to get the shorten bit.y URL in my excel file, but instead I'm obtainig the following message,

{"created_at":"2022-05-04T21:48:32+0000","id":"bitly.is/3w7FK4r","link":"https://bitly.is/3w7FK4r","custom_bitlinks":[],"long_url":"https://dev.bitly.com/","archived":false,"tags":[],"deeplinks":[],"references":{"group":"https://api-ssl.bitly.com/v4/groups/Bj7c1Yrhshv"}

how can i extract from that response only the part "link":"https://bitly.is/3w7FK4r

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Me.Range("B6:B100")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub 'If users selects more than one cell, exit sub to prevent bugs
    If Target.Value = vbNullString Then Exit Sub
    
    Dim AccToken As String
    AccToken = Sheet1.Range("C4").Value
    If AccToken = vbNullString Then
        MsgBox "Please enter your Bitly Access Token to get started" & vbCrLf & "hoi"
        Exit Sub
    End If
    
    Dim LongURL As String
    LongURL = Target.Value
    
    Dim objHTTP As Object
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    
    Dim URL As String
    URL = "https://api-ssl.bitly.com/v4/bitlinks"

    objHTTP.Open "POST", URL, False

    objHTTP.setRequestHeader "Authorization", "Bearer " & AccToken
    objHTTP.setRequestHeader "Content-type", "application/json"
    
    Dim Json As String
    Json = "{""long_url"": """ & LongURL & """,   ""domain"": ""bit.ly"",   ""group_guid"": ""account_group_guid""}" 'the group_guid for free bitly accounts is on the url https://app.bitly.com/{group_guid}/bitlinks/
    
    objHTTP.send Json
    
    Dim result As String
    result = objHTTP.responseText
    
    Me.Range("C" & Target.Row).Value = Left(result, Len(result) - 1)
    
    Set objHTTP = Nothing
End If
End Sub

Answer 1

I think your code should work now. To extractes the value in Excel with the code, it was easier mid(cell with response,72,22) if you use paid bitly it will vary.