總的來說，我對 VBA 和編碼有一些了解，但我想要的超出了我的技能水平。我正在嘗試制作一個 Excel 宏來自動縮短 Excel 檔案中的 URL（Excel 檔案的螢屏截圖）。我從其他人那里找到了一些現有代碼，但這適用于 API 的舊版本： Code for old API version。
Bitly 有關于如何連接到新 API 版本的說明，但這些說明不是用 VBA 撰寫的：Instructions New API。
Bitly API 說明還包含有關如何將 V3 API 呼叫轉換為 V4 API 呼叫的說明：Instructions on how to convert V3 to V4 API call。我試圖自己解決這個問題，但沒有任何成功。我在 Excel 中收到錯誤“{“message”：“FORBIDDEN””作為當前輸出。
到目前為止，這是我的代碼：
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objHTTP As Object
Dim Json, URL, result, AccToken, LongURL As String
If Not Intersect(Target, 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 = Empty Then Exit Sub
AccToken = Sheet1.Range("C4").Value
If AccToken = "" Then
MsgBox "Please enter your Bitly Access Token to get started" & vbCrLf & "hoi"
Exit Sub
End If
LongURL = Target.Value
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://api-ssl.bitly.com/v4/shorten"
objHTTP.Open "POST", URL, LongURL, False
objHTTP.setRequestHeader "Authorization", "Bearer {" & AccToken & "}"
'objHTTP.setRequestHeader "Authorization", "Bearer {TOKEN}"
objHTTP.setRequestHeader "Content-type", "application/json"
objHTTP.send (Json)
result = objHTTP.responseText
Range("C" & Target.Row).Value = Left(result, Len(result) - 1)
Set objHTTP = Nothing
End If
End Sub
我認為這是所需的所有資訊，但如果需要其他任何資訊，我很樂意提供這些資訊。我真的希望有人可以幫助我解決這個問題，它可能會為我節省很多作業時間。
提前非常感謝！
uj5u.com熱心網友回復：
AccToken應該沒有括號，{ }如：objHTTP.setRequestHeader "Authorization", "Bearer " & AccToken- 你
Dim Json，但你沒有值設定為這個變數（它是空的），所以你發送和空請求objHTTP.send (Json)。 - 你
LongURL不應該.Open進入你JSON，而是進入你的所以它需要objHTTP.Open "POST", URL, False和Json = "{""long_url"": ""https://dev.bitly.com"", ""domain"": ""bit.ly"", ""group_guid"": ""Ba1bc23dE4F""}"
它應該如下所示：
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/shorten"
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"": ""Ba1bc23dE4F""}"
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/408530.html
標籤：