Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
Excel VB for accessing 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
IsEmissionEstimateServiceOnline = False
End If
End Function
Function GetEmissionEstimateUrl(sEmitterCommonPlural) As String
GetEmissionEstimateUrl = LCase("" & 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)
GetEmissionEstimate = Now
Exit Function
If Err.Number = 1004 Then
GetEmissionEstimate = "Retry or check formula"
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
Next nName
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment