bit.ly API v3 update

In Shorten urls with bit.ly web API and VBA I listed some sample VBA code for shortening URLs with the bit.ly web service. As bit.ly has updated their API, here is updated code.

Bit.ly introduced the API changes on their blog: Introducing API v3. In my blog post, I used the demo userid and API key. No more. I'm afraid you'll need to sign up for your own account if you want to use their service. I have my own API key, but in these code samples it has been removed.

API documentation
Sign up for API key

I'd also like to add that I didn't fully implement several API functions, for example, my functions only take one URL at a time, whereas some bit.ly API methods can accept multiple URLs or hashes. Hey, what do you expect for free?

Two domains

First, let's note that bit.ly actually operates two domains you can use for short URLs. bit.ly and j.mp. To that end, we'll use an enumerated section that lets us select between them. Paste this at the top of a standard module, or in its own standard module.

Public Enum domain
  bitly
  jmp
End Enum

We'll need a function that can convert the number to a string for the API:

Function GetDomain(domain As domain) As String
  Select Case domain
    Case 1
      GetDomain = "j.mp"
    Case Else ' default
      GetDomain = "bit.ly"
  End Select
End Function

Shorten URLs

Pass in your userid, API key, the URL you want to shorten, and (optionally) the domain you want for the shortened URL.

Function ShortenURL(userid As String, apiKey As String, longUrl As String, _
    Optional domain As domain = bitly) As String

Dim xml As Object ' MSXML2.XMLHTTP60
Dim result As String

  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", "http://api.bit.ly/v3/shorten?login=" & userid & _
                  "&apiKey=" & apiKey & "&format=txt&longUrl=" & _
                  URLEncode(longUrl) & "&domain=" & GetDomain(domain), False
  xml.Send

  result = xml.responseText

  ShortenURL = result

End Function

Sample usage

Sub Testbitly()

Dim userid As String
Dim apiKey As String
Dim shortURL As String

  userid = "your userid"
  apiKey = "your API key"

  shortURL = ShortenURL(userid, apiKey, _
    "http://www.jpsoftwaretech.com/", jmp)
End Sub

Expand URL

Take any shortened URL and convert it back to its original form.

Function ExpandURL(userid As String, apiKey As String, _
    shortURL As String) As String

Dim xml As Object ' MSXML2.XMLHTTP60
Dim baseUrl As String
Dim result As String

  baseUrl = "http://api.bit.ly/v3/expand?login=" & userid & "&apiKey=" & _
    apiKey & "&format=txt"
  baseUrl = baseUrl & "&shortUrl=" & shortURL

  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", baseUrl, False
  xml.Send

  result = xml.responseText

  ExpandURL = result

End Function

Sample usage

Sub Testbitly()

Dim userid As String
Dim apiKey As String
Dim shortURL As String

  userid = "your userid"
  apiKey = "your API key"

  shortURL = ShortenURL(userid, apiKey, _
    "http://www.jpsoftwaretech.com/", jmp)
  Debug.Print shortURL
  Debug.Print ExpandURL(userid, apiKey, shortURL)
End Sub

Validate User Credentials

This function will tell you if the userid and API combination you pass in are a valid combination.

Function IsValidCredentials(useridToCheck As String, apiKeyToCheck As String, _
    yourUserid As String, yourAPIKey As String) As Boolean

Dim xml As Object ' MSXML2.XMLHTTP60
Dim baseUrl As String
Dim result As String

  baseUrl = "http://api.bit.ly/v3/validate?login=" & yourUserid & "&apiKey=" & _
            yourAPIKey & "&x_login=" & useridToCheck & "&x_apiKey=" & _
    apiKeyToCheck & "&format=txt"

  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", baseUrl, False
  xml.Send

  result = xml.responseText

  IsValidCredentials = (result And 1)

End Function

Sample usage

This test is pointless, but is meant to show you how to use the function.

Sub Testbitly()

Dim userid As String
Dim apiKey As String

  userid = "your userid"
  apiKey = "your API key"

  Debug.Print IsValidCredentials(userid, apiKey, userid, apiKey)
End Sub

Count those clicks

Your application can keep track of the number of times your shortened URL has been followed. Just pass in the short URL you want to check. Note that this is the number of clicks for your shortened URL, not the original longer URL.

Function GetClicks(userid As String, apiKey As String, _
    shortURL As String) As String()

Dim xml As Object ' MSXML2.XMLHTTP60
Dim baseUrl As String
Dim result As String
Dim tempFile As String
Dim tempstring() As String
Dim i As Long
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim response As Object ' MSXML2.IXMLDOMNode
Dim data As Object ' MSXML2.IXMLDOMNode
Dim clicks As Object ' MSXML2.IXMLDOMNodeList

  tempFile = environ("temp") & "\bitlyclickcount.xml"

  baseUrl = "http://api.bit.ly/v3/clicks?login=" & userid & "&apiKey=" & _
    apiKey & "&format=xml"
  baseUrl = baseUrl & "&shortUrl=" & shortURL

  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", baseUrl, False
  xml.Send

  result = xml.responseText

  ' create XML file from result
  Call CreateXMLFile(tempFile, result)

  ' create XML doc
  Set xmlDoc = CreateObject("MSXML2.DOMDocument")

  With xmlDoc
    .async = False
    .validateOnParse = False
    .Load tempFile
  End With

  ' check that the XML doc loaded
  If LoadError(xmlDoc) Then
    Exit Function
  End If

  ' get first level nodes
  Set response = xmlDoc.childNodes(1)
  Set data = response.childNodes(1)
  Set clicks = GetChildNodes(data.childNodes(0))

  ' resize array
  ReDim tempstring(1 To clicks.Length)

  For i = 1 To clicks.Length
    tempstring(i) = clicks.item(i - 1).nodeTypedValue
  Next i

  GetClicks = tempstring

End Function

To use the GetClicks function, you'll need the MSXML helper functions.

You'll also need the URLEncode function found at Free VB Code.

Sample usage

Sub Testbitly()

Dim userid As String
Dim apiKey As String
Dim shortURL As String
Dim tempstring() As String
Dim i As Long

  userid = "your userid"
  apiKey = "your API key"

  shortURL = ShortenURL(userid, apiKey, _
    "http://www.jpsoftwaretech.com/", bitly)
  tempstring = GetClicks(userid, apiKey, shortURL)

  For i = LBound(tempstring) To UBound(tempstring)
    Debug.Print tempstring(i)
  Next i

End Sub

Download sample workbook

Related Articles:

• July 30, 2010 -- An Introduction to YQL for VBA
• January 14, 2011 -- Another URL shortener API
• January 12, 2011 -- Another way to hide your email