Updating Twitter via SuperTweet using VBA

In my previous article I showed how to update a twitter status, prior to the twitter decision to remove the basic authentication api.  This article shows a way of getting around this.  The SuperTweet service allows you to continue to use basic authentication.  This is particularly useful for non-visual processes that use VBA.

I am currently using Twitter to update a private tweet-stream of my activities (such as sending email) from an Outlook 2010 macro.  This stream is then fed into the iPhone application Momento, which provides me with an “autodiary” based on my various twitter feeds and online services.

To use the SuperTweet, there are just three steps:

1. Sign In with OAuth to the SuperTweet.net  (Sign-Up/Sign-In Now)
2. Create a password for your applications to use with the SuperTweet.net API when they want to Tweet: Learn more.
3. Change your application to use http://api.supertweet.net instead of Twitter.com.  See the sample below on how to do this using WinHttp in VBA. ( Learn more.)

The VBA code below will allow you to do an update to Twitter.  The UrlEncode implementation came from this StackOverflow post.

Function PostToTwitter(statusUpdate As String, username As String, password As String) As Boolean
    Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0 
    On Error GoTo error_handler
   
    Dim WinHttpReq As New WinHttpRequest
 
     ' Assemble an HTTP Request.
    WinHttpReq.Open "POST", _
      "http://api.supertweet.net/1/statuses/update.xml", False
    WinHttpReq.SetCredentials username, password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
    ' Send the HTTP Request.
    WinHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    WinHttpReq.Send "status=" & URLEncode(statusUpdate)
    If WinHttpReq.Status <> 200 Then
      
       GoTo error_handler
    End If
    DoEvents
    Debug.Print "Posted - " & statusUpdate
   
    PostToTwitter = True
   
    Exit Function

error_handler:

    PostToTwitter = False
   
    Exit Function
       
End Function

Public Function URLEncode( _
   StringToEncode As String, _
   Optional UsePlusRatherThanHexForSpace As Boolean = False _
) As String

  Dim TempAns As String
  Dim CurChr As Integer
  CurChr = 1

  Do Until CurChr - 1 = Len(StringToEncode)
    Select Case Asc(Mid(StringToEncode, CurChr, 1))
      Case 48 To 57, 65 To 90, 97 To 122
        TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
      Case 32
        If UsePlusRatherThanHexForSpace = True Then
          TempAns = TempAns & "+"
        Else
          TempAns = TempAns & "%" & Hex(32)
        End If
      Case Else
        TempAns = TempAns & "%" & _
          Right("0" & Hex(Asc(Mid(StringToEncode, _
          CurChr, 1))), 2)
    End Select

    CurChr = CurChr + 1
  Loop

  URLEncode = TempAns
End Function