Long hyperlink bypass

[gonen]

Hi

I have a long url like this:

http://maps.google.com/maps?saddr=40.515065,-74.377585(US_NJ,Edison%20-Comfort%20Inn%20)&daddr=40.310573,-74.663411(US_NJ,Princeton%20-AAA%20)+to:39.95278,-75.149188(US_PA,Philadelphia%20-Constitution%20Hall%20)+to:39.950399,-75.15047(US_PA,Philadelphia%20-Liberty%20Bell%20)+to:39.94564,-75.14072(US_PA,Philadelphia%20-Penn%20S%20Landing%20Park%20)+to:39.9649,-75.1802(US_PA,Philadelphia%20-Rocky%20Steps%20)+to:39.9524,-75.147335(US_PA,Philadelphia%20-The%20Mint%20)+to:39.282058,-76.612648(US_MD,Baltimore%20-Maryland%20Science%20Center%20Imax%20)+to:39.286715,-76.608406(US_MD,Baltimore%20-National%20Aquarium%20In%20Baltimore%20)+to:38.88354,-77.099561(US_VA,Arlington%20-Highlander%20Motel%20)&view=map&hl=en (http://maps.google.com/maps?saddr=40.515065,-74.377585%28US_NJ,Edison%20-Comfort%20Inn%20%29&daddr=40.310573,-74.663411%28US_NJ,Princeton%20-AAA%20%29+to:39.95278,-75.149188%28US_PA,Philadelphia%20-Constitution%20Hall%20%29+to:39.950399,-75.15047%28US_PA,Philadelphia%20-Liberty%20Bell%20%29+to:39.94564,-75.14072%28US_PA,Philadelphia%20-Penn%20S%20Landing%20Park%20%29+to:39.9649,-75.1802%28US_PA,Philadelphia%20-Rocky%20Steps%20%29+to:39.9524,-75.147335%28US_PA,Philadelphia%20-The%20Mint%20%29+to:39.282058,-76.612648%28US_MD,Baltimore%20-Maryland%20Science%20Center%20Imax%20%29+to:39.286715,-76.608406%28US_MD,Baltimore%20-National%20Aquarium%20In%20Baltimore%20%29+to:38.88354,-77.099561%28US_VA,Arlington%20-Highlander%20Motel%20%29&view=map&hl=en)

I need to assign hyperlink (using VBA code) in a cell to this url but found out that the url is too long...

I tried to place the url in a cell and

ActiveCell.FormulaR1C1 = "=HYPERLINK(RC26,""Day Route"")"
or

split the url into few cells and hyperlink with

=HYPERLINK(CONCATENATE(Z5,AA5))
both not worked.


can someone help on this ?

thank you !!!

[gonen]

I tried also:


Worksheets("Main").Hyperlinks.Add Range("K" & Rwnm), long-url

it worked a little better but could not create hyperlink for url of 1100 characters long...


Any other ideas ????

thanks !!!!

[Bob Phillips]

Use one of the URL shorteners, like TinyURL! or bit.ly

[gonen]

can this be automated via vba ????

I need to run it all from VBA..

thanks for your help !

[gonen]

Well

I found this piece of code that does the tinyurl in vba

Thank you for a very nice idea !!!


for those interested - here is the code from http://www.codeforexcelandoutlook.com/blog/2009/06/create-tiny-urls-using-vba/


and also - & in url should be replaced with %26 before going to tinyurl.....





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

[Bob Phillips]

What's the point of me being here if you are going to solve it yourself :doh: I think I might steal that code!

It's good isn't it?

[gonen]

much better. :beerchug:

much much better :beerchug::beerchug:

[Kenneth Hobs]

For what it's worth, here are examples for early and late binding using tinyurl and methods for is.gd and v.gd.


' http://www.codeforexcelandoutlook.com/blog/2009/06/create-tiny-urls-using-vba/
Sub Test_GetTinyURL()
MsgBox GetTinyUrl("http://www.codeforexcelandoutlook.com/blog/")
End Sub

' http://www.codeforexcelandoutlook.com/blog/2009/06/create-tiny-urls-using-vba/
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")
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open "POST", "http://tinyurl.com/api-create.php?url=" & url, False
xml.Send
GetTinyUrl = xml.ResponseText
End Function

Sub Test_GetISGDurl()
Dim longURL As String, shortURL As String
longURL = "http://www.vbaexpress.com/forum/showthread.php?t=38420"
shortURL = GetISGDurl(longURL)
MsgBox shortURL
' MsgBox "shortURL: " & shortURL & vbLf & _
" longURL: " & GetLongURL(shortURL)
End Sub

Function GetISGDurl(url As String) As String
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

Sub Test_GetVGDurl()
Dim longURL As String, shortURL As String
longURL = "http://www.vbaexpress.com/forum/showthread.php?t=38420"
shortURL = GetVGDurl(longURL)
MsgBox shortURL
' MsgBox "shortURL: " & shortURL & vbLf & _
' longURL: " & GetLongURL(shortURL)
End Sub

' API: http://v.gd/developers.php
Function GetVGDurl(url)
Dim xml As Object
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open "POST", "http://v.gd/create.php?format=simple&url=" + url, False
xml.Send
GetVGDurl = xml.ResponseText
End Function

Sub test_GetShortURL()
Dim longURL As String, shortURL As String
longURL = "http://www.vbaexpress.com/forum/showthread.php?t=38420"
shortURL = GetShortURL(longURL)
MsgBox shortURL
' MsgBox "shortURL: " & shortURL & vbLf & "longURL: " & GetLongURL(shortURL)
End Sub

Function GetShortURL(longURL As String) As String
' requires reference to winhttp.dll in Microsoft WinHTTP Services, version 5.0 or 5.1
Dim Request As New MSXML2.XMLHTTP
Dim rc As String
With Request
.Open "POST", "http://tinyurl.com/api-create.php?url=" & longURL, False
.Send
rc = Request.ResponseText
End With
Set Request = Nothing
GetShortURL = rc
End Function

' http://www.vbaexpress.com/forum/showthread.php?t=38420
Sub Test_GetLongURL()
MsgBox GetLongURL("http://tinyurl.com/3ju3oly")
End Sub

Sub FixShortURLs()
Dim cell As Range
For Each cell In Range("A2", Range("A" & Rows.Count).End(xlUp))
cell.Offset(0, 1).Value2 = GetLongURL(cell.Value2)
Next cell
End Sub

Function GetLongURL(tinyURL As String) As String
' This project includes references to "Microsoft Internet Controls", shdocvw.dll and '"Microsoft HTML Object Library", mshtml.tlb
' Variable declarations
Dim myIE As New InternetExplorer 'New '
Dim myDoc As HTMLDocument
Dim str As String
' Make IE navigate to the URL and make browser visible
myIE.navigate tinyURL
myIE.Visible = False
' Wait for the page to load
Do While myIE.Busy Or myIE.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
' Set IE document into object
Set myDoc = myIE.document
str = myDoc.Location
Set myDoc = Nothing
Set myIE = Nothing
GetLongURL = str
End Function