Excel VB for accessing http://carbon.brighterplanet.com/flights.txt as a web service (early 2011)

excelwebservice.vb

Option Explicit

Function GetBrighterPlanetApiKey()
    GetBrighterPlanetApiKey = ActiveWorkbook.Worksheets("Setup").Range("C2").Value
End Function

Function IsEmissionEstimateServiceOnline()
    If LCase(ActiveWorkbook.Worksheets("Setup").Range("C3").Value) = "online" And ThisWorkbook.HasFinishedWorkbookOpen() = True Then
        IsEmissionEstimateServiceOnline = True
    Else
        IsEmissionEstimateServiceOnline = False
    End If
End Function

Function GetEmissionEstimateUrl(sEmitterCommonPlural) As String
    GetEmissionEstimateUrl = LCase("http://carbon.brighterplanet.com/" & sEmitterCommonPlural & ".txt")
End Function

Function GetEmissionEstimatePostText(sSheet, iRow, iColumn, iWidth) As String
    Dim rAnchor As Range
    Dim rValues As Range
    Dim rKeys As Range
    Dim i As Integer
    Dim sKey As String
    Dim sValue As String
    Dim wAnchorSheet As Worksheet
    
    GetEmissionEstimatePostText = "key=" & GetBrighterPlanetApiKey & "&"
    Set wAnchorSheet = ActiveWorkbook.Worksheets(sSheet)
    Set rAnchor = wAnchorSheet.Cells(iRow, iColumn)
    Set rValues = wAnchorSheet.Range(rAnchor, rAnchor.Offset(0, iWidth - 1))
    Set rKeys = wAnchorSheet.Range(wAnchorSheet.Cells(1, iColumn), wAnchorSheet.Cells(1, iColumn + iWidth - 1)).Cells
    For i = 1 To rKeys.Count
        sKey = rKeys.Cells(1, i).Value
        sValue = rValues.Cells(1, i).Value
        If Not IsEmpty(sValue) Then
            GetEmissionEstimatePostText = GetEmissionEstimatePostText & "&" & sKey & "=" & sValue
        End If
    Next i
End Function

Function GetEmissionEstimate(sEmitterCommonPlural As String, rCharacteristics As Range)
    If Not IsEmissionEstimateServiceOnline() Then
        GetEmissionEstimate = "Retry when online"
        Exit Function
    End If
    
    Dim sUrl As String
    Dim sPostText As String
    Dim qTable As QueryTable
    
    sUrl = GetEmissionEstimateUrl(sEmitterCommonPlural)
    sPostText = GetEmissionEstimatePostText(rCharacteristics.Worksheet.Name, rCharacteristics.Row, rCharacteristics.Column, rCharacteristics.Count)
    Set qTable = rCharacteristics.Worksheet.QueryTables.Add(Connection:="URL;" & sUrl, Destination:=rCharacteristics.Offset(0, -2))
    qTable.PostText = sPostText
    qTable.RefreshStyle = xlOverwriteCells
    qTable.SaveData = True
    On Error GoTo Rescue
    qTable.Refresh (False)
    qTable.Delete
    GetEmissionEstimate = Now
    Exit Function
Rescue:
    If Err.Number = 1004 Then
        GetEmissionEstimate = "Retry or check formula"
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description
    End If
End Function

Function CountQueryTables()
    Dim wSheet As Worksheet
    
    CountQueryTables = 0
    For Each wSheet In ActiveWorkbook.Worksheets
        CountQueryTables = CountQueryTables + wSheet.QueryTables.Count
    Next wSheet
End Function

Function CountExternalDataNames()
    Dim nName As Name
    
    CountExternalDataNames = 0
    For Each nName In ActiveWorkbook.Names
        If InStr(1, nName.Name, "ExternalData") Then
            CountExternalDataNames = CountExternalDataNames + 1
        End If
    Next nName
End Function

Function DeleteAllExternalDataNames()
    Dim nName As Name
    
    For Each nName In ActiveWorkbook.Names
        nName.Delete
    Next nName
End Function