Use VBA to shorten URLs with Goog.le?

[nikneven]

I need to shorten many many many URLs using Goog.le.

So, I have sound this site that walks through it http://www.jpsoftwaretech.com/google-url-shortener-api/ but I can't seem to make it work. It is printing results, but not getting any shortened URLs. I know he uses a custom MSXML Object Library Routines found here: http://www.jpsoftwaretech.com/vba/msxml-object-library-routines/ and I have all of those in a module in the workbook, and I have MSXML 6.0 turned on in the references.

Here is the code:

Const API_KEY As String = "XXXXXXXXXXXXXXRedactedXXXXXXXXXXXXXXX"
Const BASEURL As String = "https://www.googleapis.com/urlshortener/v1/url"

Function GetGooglURL(url As String, apiKey As String) As String
  Dim xml As Object  ' MSXML2.XMLHTTP60
  Set xml = GetMSXML
 
  If xml Is Nothing Then Exit Function
 
  With xml
    .Open "POST", BASEURL & "?key=" & API_KEY, False
    .setRequestHeader "Content-Type", "application/json"
    .send Replace("{""longUrl"": ""http://www.google.com/""}", "http://www.google.com/", url)
  End With
 
  If InStr(xml.responseText, "error") = 0 Then  ' no error occurred
    ' parse out short URL from JSON response
    GetGooglURL = Trim$(Split(xml.responseText, """")(7))
  End If
 
End Function

Function ExpandGooglURL(shortURL As String, apiKey As String) As String
' http://code.google.com/apis/urlshortener/v1/getting_started.html
  Dim xml As Object  ' MSXML2.XMLHTTP60
  Set xml = GetMSXML
 
  If xml Is Nothing Then Exit Function
 
  With xml
    .Open "GET", BASEURL & "?key=" & API_KEY & "&shortUrl=" & shortURL, False
    .send
  End With
 
  If InStr(xml.responseText, "error") = 0 Then  ' no error occurred
    ' parse out short URL from JSON response
    ExpandGooglURL = Trim$(Split(xml.responseText, """")(11))
  End If
 
End Function

Sub TestGoogl()
   Dim url As String
  Dim result As String
 
  url = "http://www.jpsoftwaretech.com/google-url-shortener-api/"
 
  result = GetGooglURL(url, API_KEY)
  Debug.Print "short url for " & url & " is: " & result
   
  result = ExpandGooglURL(result, API_KEY)
  Debug.Print "original url is " & result
   
End Sub

Any help would be greatly appreciated!

 

[Andrew Poulsom]

You seem to be missing the Function GetMSXML.

 

[nikneven]

Ack! I got it working. I stupidly forgot to turn on that API for that Auth Key.


Now, what would be the best way to call this from a sheet where I have a long URL in A1 and want a shortened URL in B1, and I don't want it to run more than once?