Bitly v4 -宏

Question

我试图在我的excel文件中获得简短的bit.yURL，但是我得到了以下消息，

{"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"}“

如何从该响应中只提取“链接”部分：“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

我觉得你的代码现在应该能用了。要用代码提取Excel中的值，mid(单元格有响应，72，22)比较容易，如果您使用付费的代码，它会有所不同。