VBA Express : Excel - Link Shortener

Excel

Link Shortener

Ease of Use

Easy

Version tested with

2013

Submitted by:

Paleo

Description:

This macro will shortener the hyperlink in the active cell.

Discussion:

Sometimes at work you need to compile multiple informations in one single spreadsheet, and this includes hyperlinks to external data. The problem is: Hyperlinks dont have the same size, so to make it standard you need to shorten them, here I will use Bitly to shorten hyperlinks and make all the same size.

Code:

instructions for use

Option Explicit Sub EncurtarUmLink() Dim Token, EndAPI, EndLongo, IniTexto, FimTexto As String Token = "In_order_to_work_you_need_to_get_a_token_from_Bitly_and_insert_it_here" Dim HttpReq As New WinHttpRequest Dim response As String EndLongo = ActiveCell.Value EndAPI = "https://api-ssl.bitly.com/v3/shorten?access_token=" & Token & "&longUrl=" & EndLongo On Error Resume Next 'This is to avoid errors on invalid URLs With HttpReq .Open "GET", EndAPI, False .Send End With response = HttpReq.ResponseText HttpReq.WaitForResponse IniTexto = InStr(response, "hash") FimTexto = IniTexto + 15 resultado = Right(Mid(response, IniTexto, (FimTexto - IniTexto)), 7) ActiveCell.Value = "http://bit.ly/" & resultado End Sub

How to use:

Go to https://bitly.com, create an account and generate a generic access token
Open Excel.
Alt + F11 to open the VBE.
Hit Tools | References and mark "Microsoft WinHTTP Services, version 5.1
Hit Insert | Module.
Paste the code there.
In code insert your generic access token on the variable Token
Close the VBE (Alt + Q or press the X in the top-right corner).

Test the code:

Select a cell where there is a hyperlink
Hit Tools | Macro | Macros...
Select EncurtarUmLink and press Run

Sample File:

LinkShortener.zip 9.85KB

Approved by Jacob Hilderbrand

This entry has been viewed 106 times.