Abbreviations.com is an online reference that provides several different lookup services. It also offers several APIs for retrieving and displaying website data in your VBA programs.
From Abbreviations.com:
Abbreviations.com is the world's largest and most comprehensive directory and search engine for acronyms, abbreviations and initialisms on the Internet. Abbreviations.com holds hundreds of thousands of entries organized by a large variety of categories from computing and the Web to governmental, medicine and business and it is expanding daily.
In this article we'll explore each API and produce some sample VBA code for consuming each one.
Note that you'll need an API key to use the abbreviations.com family of APIs. They call it a "token ID" but it's the same concept. I have an API key, but in the sample code below, it has been removed. To apply for a key, visit their API page and replace "your token ID here" with your key.
Make sure your system meets the requirements for running the code found on this page.
Don't forget to include the helper functions in your VBA project!
Abbreviations
The Abbreviations.com API allows you to pass an acronym and get its definition. In my VBA project I create the following constants:
Public Const tokenID As String = "your token ID here"
Public Const abbr_base_URL As String = _
"http://www.abbreviations.com/services/v1/abbr.aspx"
There are five parameters, but we'll ignore category, since we just want the definition and don't care about its category. There are two parameters that require enumeration, to ensure proper data entry:
- Sort Order
- Search Type
To do so I created two Enum sections:
Public Enum SortOrder ' sort by popularity, alphabetically or by category p a c End Enum Public Enum SearchType ' exact match, 'begins with' match or reverse lookup e b r End Enum
These should be placed at the top of a standard module, or in their own module with other Enums. To convert the constant into a String for the API, I wrote the following functions:
Function GetSortOrder(order As SortOrder) As String
Select Case order
Case 0
GetSortOrder = "p"
Case 1
GetSortOrder = "a"
Case 2
GetSortOrder = "c"
End Select
End Function
Function GetSearchType(st As SearchType) As String
Select Case st
Case 0
GetSearchType = "e"
Case 1
GetSearchType = "b"
Case 2
GetSearchType = "r"
End Select
End Function
The GetAbbrDefinition Function
The following function takes an acronym and returns the term, its definition, and category. The default sort order and search type are the same as the API defaults, and the XML response is cached unless the fifth parameter (forceRequery) is set to True.
Function GetAbbrDefinition(tokenID As String, term As String, _
Optional sortBy As SortOrder = p, _
Optional st As SearchType = e, _
Optional forceRequery As Boolean = False) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim rslt As Object ' MSXML2.IXMLDOMNode
Dim i As Long
Const XML_FILE_EXTENSION As String = ".xml"
tempFolder = environ("temp") & "\"
tempFile = tempFolder & term & XML_FILE_EXTENSION
' requery if cache file is missing or forceRequery set to True
If Len(Dir(tempFile)) = 0 Or forceRequery Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", abbr_base_URL & "?tokenid=" & tokenID & "&term=" & term & _
"&sortby=" & GetSortOrder(sortBy) & "&searchtype=" & GetSearchType(st), False
.Send
End With
result = xml.responseText
CreateFile tempFile, ConvertAccent(result)
End If
' load XML file into new XML document
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get root node
Set xmlDocRoot = GetRootNode(xmlDoc)
' get first level child nodes
Set results = GetChildNodes(xmlDocRoot)
' resize array
' there are 3 data points per node: term, definition and category
ReDim tempString(1 To results.Length, 1 To 3)
' loop through each node and put values into array
For i = 1 To results.Length
Set rslt = results.item(i - 1)
tempString(i, 1) = GetNode(rslt, 1).nodeTypedValue
tempString(i, 2) = GetNode(rslt, 2).nodeTypedValue
tempString(i, 3) = GetNode(rslt, 3).nodeTypedValue
Next i
GetAbbrDefinition = tempString
End Function
The GetNode function returns a given node based on position. It takes either a single node (that has child nodes) or a NodeList Object.
Sample API Response
<?xml version="1.0" encoding="UTF-8"?>
<results>
<result>
<term>asap</term>
<definition>As Soon As Possible</definition>
<category>Chat</category>
</result>
<result>
<term>asap</term>
<definition>As Soon As Possible</definition>
<category>Chat</category>
</result>
</results>
Sample usage
Sub tst()
Dim results() As String
Dim result As String
Dim i As Long, j As Long
results = GetAbbrDefinition(tokenID, "ROTFLMAO")
For i = LBound(results) To UBound(results)
For j = LBound(results, 2) To UBound(results, 2)
Debug.Print results(i, j)
Next j
Next i
End Sub
Conversions
The Conversions API takes natural language queries, evaluates them and returns the result. Place the following constants at the top of a standard module:
Public Const tokenID As String = "your token ID here"
Public Const conversion_base_URL As String = _
"http://www.convert.net/services/v1/conv.aspx"
The ConvertExpression Function
This function checks the API response for an error code. If the error code is 0 (no error) we simply grab the third node (result) and return it.
Function ConvertExpression(tokenID As String, expression As String, _
Optional forceRequery As Boolean = False) As String
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim resultNode As Object ' MSXML2.IXMLDOMNode
Const XML_FILE_EXTENSION As String = ".xml"
Const SUCCESS_CODE As Long = 0
tempFolder = environ("temp") & "\"
' make temp file case insensitive
tempFile = tempFolder & UCase$(expression) & XML_FILE_EXTENSION
' requery if cache file is missing or forceRequery set to True
If Len(Dir(tempFile)) = 0 Or forceRequery Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", conversion_base_URL & "?tokenid=" & tokenID & "&expression=" & _
expression, False
.send
End With
result = xml.responseText
CreateFile tempFile, ConvertAccent(result)
End If
' load XML file into new XML document
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get root node
Set xmlDocRoot = GetRootNode(xmlDoc)
' check for error, else get result
If GetNode(xmlDocRoot, 1).nodeTypedValue = SUCCESS_CODE Then ' no error
' get result
Set resultNode = GetNode(xmlDocRoot, 3)
ConvertExpression = resultNode.nodeTypedValue
End If
' if Len(ConvertExpression) = 0, or ConvertExpression = "", an error occurred
End Function
Sample API Response
<?xml version="1.0" encoding="UTF-8"?> <results> <errorCode>0</errorCode> <errorMessage></errorMessage> <result>5 Kilograms = 14.7 Pounds</fancyResult> <category>Measurements</category> <subcategory>Weight</subcategory> </result>
Sample Usage
Sub tst() Dim result As String result = ConvertExpression(tokenID, "5 kilometers in miles") Debug.Print result End Sub
Zip Codes API
The Zip Codes API takes a zip code and returns the location name, latitude and longitude for that zip code. Place the following constants at the top of a standard module:
Public Const tokenID As String = "your token ID here" Public Const zip_base_URL As String = "http://www.uszip.com/services/v1/zip.aspx"
The GetLocationFromZip Function
Function GetLocationFromZip(tokenID As String, zipCode As String, _
Optional forceRequery As Boolean = False) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim resultNode As Object ' MSXML2.IXMLDOMNode
Const XML_FILE_EXTENSION As String = ".xml"
tempFolder = environ("temp") & "\"
tempFile = tempFolder & zipCode & XML_FILE_EXTENSION
' requery if cache file is missing or forceRequery set to True
If Len(Dir(tempFile)) = 0 Or forceRequery Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", zip_base_URL & "?tokenid=" & tokenID & "&zip=" & zipCode, False
.send
End With
result = xml.responseText
CreateFile tempFile, ConvertAccent(result)
End If
' load XML file into new XML document
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get root node
Set xmlDocRoot = GetRootNode(xmlDoc)
Set resultNode = GetNode(xmlDocRoot, 1)
' resize array
ReDim tempString(1 To 1, 1 To resultNode.childNodes.Length)
tempString(1, 1) = GetNode(resultNode, 1).nodeTypedValue
tempString(1, 2) = GetNode(resultNode, 2).nodeTypedValue
tempString(1, 3) = GetNode(resultNode, 3).nodeTypedValue
GetLocationFromZip = tempString
End Function
The API response is very small so it's easy to parse.
Sample API Response
<?xml version="1.0" encoding="UTF-8"?> <results> <location>Beverly Hills, California</location> <longitude>-118.4061250000</longitude> <latitude>34.0888080000</latitude> </result>
Sample Usage
Sub tst()
Dim results() As String
Dim i As Long, j As Long
results = GetLocationFromZip(tokenID, "11103")
For i = LBound(results) To UBound(results)
For j = LBound(results, 2) To UBound(results, 2)
Debug.Print results(i, j)
Next j
Next i
End Sub
Synonyms API
The Synonyms API takes a word and returns synonyms, parts of speech, definition and antonyms. Place the following constants at the top of a standard module:
Public Const tokenID As String = "your token ID here"
Public Const synonyms_base_URL As String = _
"http://www.abbreviations.com/services/v1/syno.aspx"
The GetSynonyms Function
Pass in your API key and a word and this function returns the following five data points:
- the word itself
- definition
- part of speech
- synonyms
- antonyms
Function GetSynonyms(tokenID As String, word As String, _
Optional forceRequery As Boolean = False) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim resultNode As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long
Dim i As Long
Const XML_FILE_EXTENSION As String = ".xml"
tempFolder = environ("temp") & "\"
tempFile = tempFolder & word & XML_FILE_EXTENSION
' requery if cache file is missing or forceRequery set to True
If Len(Dir(tempFile)) = 0 Or forceRequery Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", synonyms_base_URL & "?tokenid=" & tokenID & "&word=" & word, False
.send
End With
result = xml.responseText
CreateFile tempFile, ConvertAccent(result)
End If
' load XML file into new XML document
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get root node
Set xmlDocRoot = GetRootNode(xmlDoc)
numRows = xmlDocRoot.childNodes.Length
' resize array
' each node has five data points
ReDim tempString(1 To numRows, 1 To 5)
' loop through nodes and write values to array
For i = 1 To numRows
' grab each result node
Set resultNode = GetNode(xmlDocRoot, i)
' child nodes have value to extract
tempString(i, 1) = GetNode(resultNode, 1).nodeTypedValue
tempString(i, 2) = GetNode(resultNode, 2).nodeTypedValue
tempString(i, 3) = GetNode(resultNode, 3).nodeTypedValue
tempString(i, 4) = GetNode(resultNode, 4).nodeTypedValue
tempString(i, 5) = GetNode(resultNode, 5).nodeTypedValue
Next i
GetSynonyms = tempString
End Function
Sample API Response
<?xml version="1.0" encoding="UTF-8"?>
<results>
<result>
<term>consistent</term>
<definition>(sometimes followed by `with') in agreement or consistent or reliable</definition>
<partofspeach>adj</partofspeach>
<synonyms>ordered, coherent, logical, reproducible, uniform</synonyms>
<antonyms>scratchy, unreconciled, uneven, contradictory, inconsistent, conflicting, incompatible, spotty, heterogeneous, discrepant, heterogenous, self-contradictory, unconformable</antonyms>
</result>
</results>
Sample Usage
Sub tst()
Dim results() As String
Dim i As Long, j As Long
results = GetSynonyms(tokenID, "barren")
For i = LBound(results) To UBound(results)
For j = LBound(results, 2) To UBound(results, 2)
Debug.Print results(i, j)
Next j
Next i
End Sub
Definitions API
The Definitions API returns similar information to the Synonyms API. It returns
- the term you pass to the API
- definition
- part of speech
- example usage
Place the following constants at the top of a standard module:
Public Const tokenID As String = "your token ID here"
Public Const definitions_base_URL As String = _
"http://www.abbreviations.com/services/v1/defs.aspx"
The GetSynonyms Function
As with the other functions, this function caches the API response, then uses GetNode to return the node values.
Function GetDefinition(tokenID As String, word As String, _
Optional forceRequery As Boolean = False) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFolder As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim resultNode As Object ' MSXML2.IXMLDOMNode
Const XML_FILE_EXTENSION As String = ".xml"
tempFolder = environ("temp") & "\"
tempFile = tempFolder & word & XML_FILE_EXTENSION
' requery if cache file is missing or forceRequery set to True
If Len(Dir(tempFile)) = 0 Or forceRequery Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", definitions_base_URL & "?tokenid=" & tokenID & "&word=" & word, False
.send
End With
result = xml.responseText
CreateFile tempFile, ConvertAccent(result)
End If
' load XML file into new XML document
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get root node
Set xmlDocRoot = GetRootNode(xmlDoc)
Set resultNode = GetNode(xmlDocRoot, 1)
' resize array
ReDim tempString(1 To 1, 1 To resultNode.childNodes.Length)
tempString(1, 1) = GetNode(resultNode, 1).nodeTypedValue
tempString(1, 2) = GetNode(resultNode, 2).nodeTypedValue
tempString(1, 3) = GetNode(resultNode, 3).nodeTypedValue
GetDefinition = tempString
End Function
Sample API Response
<?xml version="1.0" encoding="UTF-8"?>
<results>
<result>
<term>consistent, uniform</term>
<definition>the same throughout in structure or composition</definition>
<partofspeach>adj</partofspeach>
<example>bituminous coal is often treated as a consistent and homogeneous product</example>
</result>
</results>
Sample Usage
Sub tst()
Dim results() As String
Dim i As Long, j As Long
results = GetDefinition(tokenID, "justified")
For i = LBound(results) To UBound(results)
For j = LBound(results, 2) To UBound(results, 2)
Debug.Print results(i, j)
Next j
Next i
End Sub
One last thing: Each function includes a parameter to force requery of the API. In order to be a responsible API user (and observe Abbreviations.com's query limit of 1,000 queries per day), each function caches the API response in the local temp folder.
For the most part, responses will be duplicated anyway (how often does latitude and longitude for a given zip code change?) so there is no reason to keep asking the API for updates.
If you clear the temp folder (or explicitly ask the function to do so), the functions will requery the API. You can use a function like this to clear the local temp folder:
Function ClearCache(Optional fileExtension As String = "xml")
' deletes stored files from temp folder
Dim filesToDelete As String
filesToDelete = Environ("temp") & "\*." & fileExtension
Kill filesToDelete
End Function
You can also update the function to include a date or timestamp in the filename. This information can then be parsed out and compared with the current date and time to see if the function needs to be re-run (with forceRequery set to True, of course).
