PDA

View Full Version : Long hyperlink bypass



gonen
09-26-2011, 10:48 PM
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
09-27-2011, 01:04 AM
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
09-27-2011, 01:10 AM
Use one of the URL shorteners, like TinyURL! or bit.ly

gonen
09-27-2011, 01:12 AM
can this be automated via vba ????

I need to run it all from VBA..

thanks for your help !

gonen
09-27-2011, 01:48 AM
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
09-27-2011, 02:53 AM
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
09-27-2011, 02:54 AM
much better. :beerchug:

much much better :beerchug::beerchug:

Kenneth Hobs
09-27-2011, 05:38 AM
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