Skip to content

Instantly share code, notes, and snippets.

@seamusabshere
Created September 28, 2012 15:44
Show Gist options
  • Save seamusabshere/3800611 to your computer and use it in GitHub Desktop.
Save seamusabshere/3800611 to your computer and use it in GitHub Desktop.
Excel VB for accessing http://carbon.brighterplanet.com/flights.txt as a web service (early 2011)
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment