Create Tiny URLs using VBA

A recent visitor to the site sent me some code that generates tiny urls programmatically. It uses the Internetexplorer.Application object to automatically insert text in the appropriate text boxes on tinyurl.com and submit the form to generate a shortened URL.

I came up with some alternate code that uses XMLHTTP to do the same thing, with a few benefits:

  • The code is much shorter.
  • It runs much faster.

The TinyURL service has an undocumented API that lets you pass in a URL and it returns a plain text tinyurl link that you can use in emails and for posting really long links in forums. All we need to do is pass the URL and read the response text.

Function GetTinyUrl(url As String) As String
' based on http://chandoo.org/wp/2009/02/05/twitter-from-excel/
' tinyurl API creation link from:
' http://www.wprecipes.com/how-to-automatically-provide-tinyurls-for-your-wordpress-blog-posts

Dim xml As Object
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

xml.Open "POST", "http://tinyurl.com/api-create.php?url=" & url, False
xml.Send

GetTinyUrl = xml.responsetext

End Function

Usage:

Sub testme()

MsgBox GetTinyUrl("http://www.jpsoftwaretech.com/blog/")

End Sub

In fact we can use this for any URL shortening service that has a public API that returns a shortened link when passed a URL. For example http://is.gd/ is another service we can use.

Function GetISGDUrl(url As String) As String
Dim xml As Object
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

xml.Open "POST", "http://is.gd/api.php?longurl=" & url, False
xml.Send

GetISGDUrl = xml.responsetext

End Function

These can be used in any program that supports VBA (Word, Outlook, Excel, Access, etc) where you might want to generate shortened URLs.

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 »



Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 6 Comment(s) on Create Tiny URLs using VBA:

  1. Peter H. Williams writes:

    Hi,

    I got to this post via a general search and the code was just what I wanted. I wanted to automate some aspect of creating affiliate links into shareasale.. The coding is fairly straight forward and the correct data is posted into columns 2 and 4. The shortened link in column 6 is the same for each row (the first pass in the loop generates a tiny link – which appears invalid – as far as shareasale is concerned – but that's another matter!)

    When I look at the object data I see a message as follows:-

    "The data necessary to complete this operation is not yet available."

    Any ideas why I get this error?
    Do I need to do a reset somewhere?
    Is it a timing issue?

    Private Sub CommandButton1_Click()
    '====================Link Converter
    Dim i1 As Integer, i2 As Integer
    Dim myURL As String
    Dim myvendorURL As String
    Dim ShareasaleURL As String
    Dim t1 As String, t2 As String
        myvendorURL = Sheets("Master").Cells(1, 4)
        myvendorURL = Replace(myvendorURL, "http://", "")
        ShareasaleURL = Sheets("Master").Cells(2, 4)
        For i1 = 7 To 16
            t1 = Trim(LCase(Sheets("Master").Cells(i1, 1)))
            t1 = Replace(t1, " ", "-")
            myURL = Replace(myvendorURL, "XXXXXX", t1)
            Sheets("Master").Cells(i1, 2) = "http://" + myURL
            myURL = Replace(myURL, ".", "%2E")
            myURL = Replace(myURL, "/", "%2F")
            myURL = Replace(myURL, "-", "%2D")
            myURL = ShareasaleURL + myURL
            Sheets("Master").Cells(i1, 4) = myURL
            t2 = GetTinyUrl(myURL)
            Sheets("Master").Cells(i1, 6) = GetTinyUrl(myURL)
        Next i1
    End Sub
    
    Function GetTinyUrl(url As String) As String
    ' based on http://chandoo.org/wp/2009/02/05/twitter-from-excel/
    ' tinyurl API creation link from:
    ' http://www.wprecipes.com/how-to-automatically-provide-tinyurls-for-your-wordpress-blog-posts
    Dim xml As Object
        Set xml = CreateObject("MSXML2.XMLHTTP")
        xml.Open "POST", "http://tinyurl.com/api-create.php?url=" & url, False
        xml.Send
        GetTinyUrl = xml.responsetext
    End Function
    
    
  2. Peter H. Williams writes:

    I created a single shot version of the above and that seems to work fine with simple URLs.

    It seems that the API doesn't handle the complicated affiliate link

    eg http://www.shareasale.com/r.cfm?u=185049&b=166965&m=12747&afftrack=&urllink=www%2Etoolking%2Ecom%2Fcategory%2Fsearch%2Dby%2Dbrand%2Fdewalt%2Dtools%2Easpx

    If I create a tiny.url at the tiny website then it does provide me with a valid shortened tiny url which works!

    Looks like it fails to handle the URL and then returns whatever it has – which is the same for each variation of the shareasale links

This article is closed to any future comments.
Peltier Tech Charting Utilities for Excel