Thank you in advance for any help!! First time using api calls. Trying to input an ISBN into a cell the retrieving information from my inventory file located at artofbooks.com Their documentation for their API calls is not that great. This is my code and I am getting a "bad token" error.
sub test
creds = EncodeBase64("{ AOB_AUTH_USER : cottagebooks, AOB_AUTH_PW : xxxxxx }")
isbn = Cells(5, 3).Value
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
URL = "https://www.theartofbooks.com/api/2.0/item=2010101257"
objHttp.Open "GET", URL, False
objHttp.SetRequestHeader "Content-Type", "multipart/form-data"
objHttp.SetRequestHeader "Accept", "application/xml"
objHttp.SetRequestHeader "Authorization:", "Bearer " & creds
objHttp.Send
strResponseStatus = objHttp.Status
strresponsetext = objHttp.ResponseText
strresponsetext = CStr(strresponsetext)
MsgBox strresponsetext
end sub
Related
I'm trying to make an Excel Macro to automatically shorten URLs in an Excel file.
().
I found existing code however this applies to an old version of the API:
Bitly has instructions on how to connect to the new API version, however these are not written in VBA:
The Bitly API instructions also contain instructions on how to convert a V3 API call to a V4 API call:
I tried to fix this. In Excel I get the error
'{"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
AccToken should be without brackets { } like: objHTTP.setRequestHeader "Authorization", "Bearer " & AccToken
You Dim Json but you set no value to this variable (it is empty) and so you send and empty request objHTTP.send (Json).
Your LongURL shoud not go into tho .Open but into your JSON so it needs to be objHTTP.Open "POST", URL, False and Json = "{""long_url"": ""https://dev.bitly.com"", ""domain"": ""bit.ly"", ""group_guid"": ""Ba1bc23dE4F""}"
It should look something like below:
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
Using VBA, I am able to authenticate the user and obtain 'code' successfully using my sandbox account. However, when I attempt to exchange the permission token for an access token, I get status code 400, Bad Request (unsupported_grant_type). I searched for similar problems and tried many suggestions to no avail. I have been successful in using the implicit grant process, but would like to now switch to code grant. I validated the Base64 conversion using an online tool. It worked fine. The process looks very simple and straight forward. Any help is much appreciated.
The VBA code I'm using follows:
strURL = "https://account-d.docusign.com/oauth/token"
strAuthorization = Base64EncodeString(gstrIntegrationKey & ":" & gstrSecretKey)
Set objJSON = New Dictionary
objJSON.Add "grant_type", "authorization_code"
objJSON.Add "code", strCode
strJSON = JsonConverter.ConvertToJson(objJSON)
Set objHTTP = New MSXML2.XMLHTTP60
objHTTP.Open "POST", strURL, False
objHTTP.setRequestHeader "Content-Type: ", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "Accept: ", "application/json"
objHTTP.setRequestHeader "Authorization: ", "Basic " & strAuthorization
objHTTP.send strJSON
Do Until objHTTP.ReadyState = 4
DoEvents
Loop
strResponse = Replace(objHTTP.responseText, "null", """null""")
If objHTTP.Status <> 200 Then
If Not DocuSignErr(strResponse, objHTTP.Status, objHTTP.statusText) Then Stop
GoTo FailedExit
End If
The body should be form URL encoded not JSON encoded. Instead of using the Dictionary and running it through JsonConverter.ConvertToJson, you should encode it in as a form (e.g., value1=a&value2=b). So, you can do something like this:
strURL = "https://account-d.docusign.com/oauth/token"
strAuthorization = Base64EncodeString(gstrIntegrationKey & ":" & gstrSecretKey)
Set objHTTP = New MSXML2.XMLHTTP60
objHTTP.Open "POST", strURL, False
objHTTP.setRequestHeader "Content-Type: ", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "Accept: ", "application/json"
objHTTP.setRequestHeader "Authorization: ", "Basic " & strAuthorization
objHTTP.send "grant_type=authorization_code&code=" & strCode
...
Am trying to retrieve data as JSON with the following code, but am just getting an XML response:
Public Sub vbajson()
Dim http As Object
Dim sht As Worksheet
Dim authKey As String
Dim accNr As String
Set sht = Worksheets("Account")
authKey = "abc"
accNr = "123"
Set http = CreateObject("MSXML2.XMLHTTP")
With http
.Open "GET", "https://api.tradier.com/v1/accounts/" & accNr & "/balances", False
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Authorization", "Bearer " & authKey
.Send
End With
MsgBox http.responsetext
End Sub
msgbox output:
instead of using
.Open "GET", "https://api.tradier.com/v1/accounts/" & accNr & "/balances", False
I tested the following link, leaving the rest of the VBA code unchanged:
.Open "GET", "http://jsonplaceholder.typicode.com/users", False`
and get the following result, which is the data structure I want:
Am also getting data in JSON structure using the following Python code (code borrowed from here: https://documentation.tradier.com/brokerage-api/accounts/get-account-balance)
import requests
response = requests.get('https://api.tradier.com/v1/accounts/123/positions',
params={},
headers={'Authorization': 'Bearer abc', 'Accept': 'application/json'}
)
json_response = response.json()
print(response.status_code)
print(json_response)
Any idea how I need to update my VBA code to get the data in JSON structure? What is the issue?
I want to get JSON, as xml will no longer be supported once the API gets updated.
Thanks to the help and code from #QHarr I have got the tracking info from Fedex, DHL and Startrack working. I have been trying to use his code and the UPS tracking Web Service Developer Guide and Tracking JSON Developer Guides to get UPS to work as well within Excel. The JSON converter code is from here https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas
The code I have tried is as follows
Public Function GetUPSDeliveryDate(ByVal id As String) As String
Dim body As String, json As Object
body = "data={""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":" & Chr$(34) & id & Chr$(34) & ",""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
body = body & "&action=trackpackages&locale=en_AU&version=1&format=json"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://wwwapps.ups.com/WebTracking", False
.setRequestHeader "Referer", "https://www.ups.com/track?loc=en_AU&tracknum=" & id
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send body
Set json = JSONConverter.ParseJson(.responseText)
End With
GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")
End Function
I am not getting any errors in the code per-say, but when I use the =GetUPSDeliveryDate() function I am getting a #VALUE! response instead of the delivered date of 7th May 2019, so I am guessing I have got the following bit wrong
GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")
I have also tried the following, but no luck.
If json("results")(1)("delivery")("status") = "delivered" Then
GetUPSDeliveryDate = json("results")(1)("checkpoints")(1)("date")
Else
GetUPSDeliveryDate = vbNullString
End If
A sample UPS tracking number is 1Z740YX80140148107
Any help would be greatly appreciated.
Thanks
The following is by mimicking of this UPS tracking site. The json parser used is jsonconverter.bas: Download raw code from here and add to standard module called jsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime.
Option Explicit
Public Sub test()
Debug.Print GetUPSDeliveryDate("1Z740YX80140148107")
End Sub
Public Function GetUPSDeliveryDate(ByVal id As String) As String
Dim body As String, json As Object
body = "{""Locale"":""en_US"",""TrackingNumber"":[""" & id & """]}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://www.ups.com/track/api/Track/GetStatus?loc=en_US", False
.setRequestHeader "Referer", "https://www.ups.com/track?loc=en_US&requester=ST/"
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "DNT", "1"
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json, text/plain, */*"
.send body
Set json = JsonConverter.ParseJson(.responseText)
End With
If json("trackDetails")(1)("packageStatus") = "Delivered" Then
GetUPSDeliveryDate = json("trackDetails")(1)("deliveredDate")
Else
GetUPSDeliveryDate = "Not yet delivered"
End If
End Function
The Tracking Web Service Developer Guide.pdf contains all you need to know to set up using the official tracking API.
Been stuck on this for a few days now.
Trying to obtain access token from an API with oauth2 authentication.
But I keep getting '401 Unauthorized',
"Full authentication is required'
My gues is i'm doing something wrong with the
.SetRequestHeder "Authorization", "basic " + (base64 encoded)
Here's the code so far: (worked with another API)
Username = "myusername"
Password = "myclientsecret"
PasswordnUsername = Password & ":" & Username
argumentString = "?grant_type=password&username=myusername&password=mypassword"
Set xmlhttp = CreateObject("MSXML2.XMLHTTP.6.0")
xmlhttp.Open "POST", "https://api.url/partner/oauth/token", False
xmlhttp.SetRequestHeader "Authorization", "basic " + mdl_API_MB_ACCESS_TOKEN.Base64Encode(PasswordnUsername)
xmlhttp.SetRequestHeader "x-api-key", "myxapicode"
xmlhttp.Send (argumentString)