More XMLHTTP Web API examples

October 16, 2009 by JP

Courtesy of Programmable Web, here are three more VBA functions that can be used to return shortened URLs from three different services (r.im, timesurl, qr.cx). I've also posted sample code to create tiny URLs and is.gd shortened URLs.

These sites have basically the same function, and all three return shortened URLs as their only response, so coding these was easy. I'm working on a procedure for shortening URLs using bit.ly, but they return a XML document (instead of just a short url). I'm trying to actually parse the XML the right way, which is taking longer than I thought.

Function GetRIMShortUrl(url As String) As String
' see http://r.im/api.cfm
Dim xml As Object
  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "POST", "http://r.im/api/index.cfm?long_url=" & url, False
  xml.Send

  GetRIMShortUrl = xml.responsetext

End Function

Function GetTimesShortUrl(url As String) As String
' see http://timesurl.at/api/
Dim xml As Object
  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "POST", "http://timesurl.at/api/rest.php?url=" & url, False
  xml.Send

  GetTimesShortUrl = xml.responsetext

End Function

Function GetQRCXShortUrl(url As String) As String
' http://qr.cx/api.php
Dim xml As Object
  Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

  xml.Open "GET", "http://qr.cx/api/?longurl=" & url, False
  xml.Send

  GetQRCXShortUrl = xml.responsetext

End Function

Sample usage:

Sub tst()

  Debug.Print GetRIMShortUrl("http://www.jpsoftwaretech.com/")
  Debug.Print GetTimesShortUrl("http://www.jpsoftwaretech.com/")
  Debug.Print GetQRCXShortUrl("http://www.jpsoftwaretech.com/")

End Sub

Note that these functions will only shorten the URL. Most of these APIs also include parameters for returning the original URL, when passed a shortened URL. None of the functions I posted will do that, so if you'd like to see that then let me know.