Create Tiny URLs using VBA
June 17, 2009 • JP • No Comments • Rate This Article
• Links to this article
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.
' 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
Usage:
MsgBox GetTinyUrl("http://www.codeforexcelandoutlook.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.
Dim xml As Object
Set xml = CreateObject("MSXML2.XMLHTTP")
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.
VBA ·
Rate This Article:
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
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 if you want to learn more about VBA. Keep Reading »
Previous Post: Populate Access combo box from a VBA array
Next Post: Case changing and checking in Excel
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?
'====================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
My only thoughts are:
The link is invalid.
You made too many requests and hit the API limit.
Try calling the function with a simple URL like http://www.google.com and see if it works.
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