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 = GetMSXML

  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 = GetMSXML

  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 = GetMSXML

  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 = GetMSXML

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

  result = xml.responseText

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

  ' create XML doc
  Set xmlDoc = GetDomDoc

  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

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »


Related Articles:


Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 11 Comment(s) on bit.ly API v3 update:

  1. Hi, thanks for the code!
    one question, if you use the ExpandURL function as part of a formula in a cell there is an unknown character at the end of the returned string (a sort of carriage return I suppose). Do you know how to remove it? I've tried Trim and Replace functions without success…

    • How about the Clean Function? Or edit the function itself, something like

      ExpandURL = Left$(result, Len(result) - 1)
  2. Hello, I love your idea for counting the clicks from bit.ly! Do you have an excel file already done that you could post as an example? I can't seem to get mine working correctly.
    Thank you and great blog!
    ~Dan

  3. That would be great, you ROCK!
    I have excel 2003.
    Thank you very much!
    ~Dan

    • I added a link to a sample workbook at the end of the article. Look for "Download sample workbook" and click the link to download 2003 and 2007 versions of the file.

  4. This is exactly what I needed! Thank you again!

  5. Anthony Stretten writes:

    Hi JP,

    Can i ask how i could get it to work over a range if cells. At the moment i have 40+ urls to convert and wondered if you know of a way round this.

    Cheers,
    Anthony

    • You would need a wrapper procedure that calls the ShortenURL function for each cell in the range. Here is some air code:

      Dim cell As Excel.Range
      For Each cell In Selection
        cell.Value = ShortenURL(userid, apiKey, cell.Value, bitly)
      Next cell
      • Anthony Stretten writes:

        Cheers JP, will have a play and will let you know how i get on.

        • Anthony Stretten writes:

          Sorry, can not get the coding to work. Keep getting an error on:

          "For Each cell In Selection"

          Could you possible add this coding to an excel doc for download?

          Thank you for all your help

          regards

          Anthony

This article is closed to any future comments.
learn excel dashboards