From SBA.Gov:
SBA.gov's Web Service API provides methods for obtaining small business resources and geographic data used by SBA.gov's core search tools including its award-winning state and local search engine, loans and grants search, and licenses and permits search.
Using SBA.gov's API, software developers can build new applications and mashups using authoritative information from Federal, state and local government agencies. The API is free of charge, does not require registration, and allows for unlimited calls.
The SBA.gov API is RESTful. Output formats are available in either XML or JSON. Each web service begins with a base URL followed by parameters and arguments. Parameters and arguments are separated by a forward slash ("/").
Following are sample methods for consuming SBA.gov API data in your VBA programs.
You'll also need to include the code from the Enum Section and the Helper Functions in order for these functions to work.
U.S. City and County Web Data API
This function returns all city and county geographic data for a given state. Naturally this will be the largest available data set for a given state.
Function GetAllCityCountyURLs(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-methods#all
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "AllCityCountyURLs"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/city_county_links_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllCityCountyURLs = tempString
End Function
All City URLs in a State
We can filter the above results by city, so that we only get geo data for the cities available in a given state.
Function GetAllCityURLs(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-methods#allcity
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "AllCityURLs"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/city_links_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllCityURLs = tempString
End Function
All County URLs in a State
We can also filter the above results so we only return the county geo data for a given state.
Function GetAllCountyURLs(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-methods#allcounty
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "AllCountyURLs"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/county_links_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllCountyURLs = tempString
End Function
All URLs for a Specific City
This function returns all geo data for a given city and state combination. The state parameter is enumerated, but there is no validation on the city.
Function GetAllURLsByCity(stateAbbr As stateAbbr, city As String) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-methods#city
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "AllURLsByCity"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & city & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/all_links_for_city_of/" & URLEncode(city) & _
"/" & state & XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllURLsByCity = tempString
End Function
All URLs by City and County
We can also filter by county when returning geo data from the business.gov API. This function takes a state abbreviation and county name (no validation).
Function GetAllURLsByCityAndCounty(stateAbbr As stateAbbr, county As String) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-methods#county
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
Dim countyName As String
state = GetStateAbbr(stateAbbr)
' at some point I'll update this to check the web for
' the correct county name
countyName = county
If Right$(countyName, 6) <> "County" Then
countyName = countyName & " County"
End If
Const TEMP_FILENAME As String = "AllURLsByCityAndCounty"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & _
countyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/all_links_for_county_of/" & URLEncode(countyName) & _
"/" & state & XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllURLsByCityAndCounty = tempString
End Function
Return Primary URLs for a State
This function returns the primary URLs for all cities and counties in a given state.
Function GetAllPrimaryURLsInState(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-primary-methods#all
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "AllPrimaryURLsInState"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/primary_city_county_links_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllPrimaryURLsInState = tempString
End Function
Return Primary URLs for all Cities in a State
This function will return geo data (including the official city government URL) for all cities in a given state. Here's an example of the XML response from the API:
<site> <county-name type="NilClass">Montgomery</county-name> <description nil="true" /> <feat-class type="NilClass">Civil</feat-class> <feature-id type="integer">1216850</feature-id> <fips-class type="NilClass">T1</fips-class> <fips-county-cd type="NilClass">91</fips-county-cd> <full-county-name type="NilClass">Montgomery County</full-county-name> <link-title type="NilClass" nil="true" /> <name>Township of Abington</name> <primary-latitude type="NilClass">40.1</primary-latitude> <primary-longitude type="NilClass">-75.09</primary-longitude> <state-abbreviation type="NilClass">PA</state-abbreviation> <state-name type="NilClass">Pennsylvania</state-name> <url>http://www.abington.org/</url> </site>
And here's the function:
Function GetPrimaryURLsAllCitiesInState(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-primary-methods#allcity
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "PrimaryURLsAllCitiesInState"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/primary_city_links_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetPrimaryURLsAllCitiesInState = tempString
End Function
Geo Data For All Counties In A Given State
This function returns the same information as above, except for all counties in a state only (instead of cities only).
Function GetPrimaryURLsAllCountiesInState(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-primary-methods#allcounty
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "PrimaryURLsAllCountiesInState"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/primary_county_links_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetPrimaryURLsAllCountiesInState = tempString
End Function
Return Geo Data for a Specific City
If you want to return geo data for just a particular city, use this function. It returns just the individual geo data for that city. Note that no validation is performed to ensure that the city name is spelled correctly or that it actually exists.
Function GetPrimaryURLByCity(stateAbbr As stateAbbr, city As String) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-primary-methods#city
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "PrimaryURLByCity"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & _
city & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/primary_links_for_city_of/" & URLEncode(city) & _
"/" & state & XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetPrimaryURLByCity = tempString
End Function
Geo Data For City and County, Filtered By County
In addition to returning county-only data, the API can also return city and county geo data for a specific county.
Function GetPrimaryCityAndCountyURLByCounty(stateAbbr As stateAbbr, county As String) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-primary-methods#county
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
Dim countyName As String
state = GetStateAbbr(stateAbbr)
' at some point I'll update this to check the web for
' the correct county name
countyName = county
If Right$(countyName, 6) <> "County" Then
countyName = countyName & " County"
End If
Const TEMP_FILENAME As String = "PrimaryCityAndCountyURLByCounty"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & _
countyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/primary_links_for_county_of/" & _
URLEncode(countyName) & "/" & state & XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetPrimaryCityAndCountyURLByCounty = tempString
End Function
Return all Geo Data By State
Similar to the GetAllCityCountyURLs function, this function returns all geodata available for a given state.
Function GetAllDataByState(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-data-methods#all
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "AllDataByState"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & _
TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/city_county_data_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllDataByState = tempString
End Function
Return Geo Data For All Cities in a State
We can filter the geo data to only return information on each city in a given state.
Function GetDataAllCitiesByState(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-data-methods#allcity
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "DataAllCitiesByState"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & _
XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/city_data_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetDataAllCitiesByState = tempString
End Function
Return Geo Data For All Counties in a State
We can also filter the geo data to only return information on each county in a given state.
Function GetDataAllCountiesByState(stateAbbr As stateAbbr) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-data-methods#allcounty
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "DataAllCountiesByState"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/county_data_for_state_of/" & state & _
XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetDataAllCountiesByState = tempString
End Function
Return Geo Data For a Specific City
The output from the API can be filtered further, to return information about a particular city in a given state.
Function GetDataByCity(stateAbbr As stateAbbr, city As String) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-data-methods#city
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
state = GetStateAbbr(stateAbbr)
Const TEMP_FILENAME As String = "DataByCity"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & _
city & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/geodata/all_data_for_city_of/" & URLEncode(city) & _
"/" & state & XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetDataByCity = tempString
End Function
Return Geo Data For a Given County
This function returns all city and county geodata for a given county.
Function GetAllDataByCounty(stateAbbr As stateAbbr, county As String) As String()
' http://www.sba.gov/content/us-city-and-county-web-data-api-city-county-data-all-data-methods#county
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim sites As Object ' MSXML2.IXMLDOMNodeList
Dim site As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
Dim countyName As String
state = GetStateAbbr(stateAbbr)
' at some point I'll update this to check the web for
' the correct county name
countyName = county
If Right$(countyName, 6) <> "County" Then
countyName = countyName & " County"
End If
Const TEMP_FILENAME As String = "AllDataByCounty"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = Environ("temp") & "\" & TEMP_FILENAME & state & countyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/geodata/all_data_for_county_of/" & URLEncode(countyName) & "/" & state & XML_FILE_EXTENSION, False
.Send
End With
result = ConvertAccent(xml.responseText)
' save result as temp XML document
tempFile = CreateFile(tempFile, 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 sites = GetChildNodes(xmlDocRoot)
' resize array
numRows = sites.Length
' assume all nodes have the same length
numCols = sites.item(0).childNodes.Length
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set site = sites.item(i - 1)
For j = 1 To numCols
tempString(i, j) = site.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetAllDataByCounty = tempString
End Function
Sample Usage
The following procedure runs each of the above functions and prints their output to the Immediate Window.
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetAllCityCountyURLs(ARIZONA)
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
results = GetAllCityURLs(ARIZONA)
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
results = GetAllCountyURLs(ARIZONA)
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
results = GetAllURLsByCity(ARIZONA, "Phoenix")
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
results = GetAllURLsByCityAndCounty(ARIZONA, "Maricopa")
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
results = GetAllPrimaryURLsInState(ARIZONA)
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
results = GetPrimaryURLsAllCitiesInState(ARIZONA)
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
results = GetPrimaryURLsAllCountiesInState(ARIZONA)
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
results = GetPrimaryURLByCity(ALASKA, "Juneau")
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
results = GetPrimaryCityAndCountyURLByCounty(NEW_YORK, "New York")
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
results = GetAllDataByState(KANSAS)
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
results = GetDataAllCitiesByState(OREGON)
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
results = GetAllDataByCounty(NEW_YORK, "Kings")
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
results = GetDataByCity(WISCONSIN, "Madison")
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
results = GetDataAllCountiesByState(LOUISIANA)
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
Helper Functions
These functions should be pasted into a standard module in the same project as the business.gov API methods. You'll also need to grab the URLEncode function.
Function GetBusinessName(business As businessType) As String
Select Case business
Case 0: GetBusinessName = "General Business Licenses"
Case 1: GetBusinessName = "Auto Dealership"
Case 2: GetBusinessName = "Barber Shop"
Case 3: GetBusinessName = "Beauty Salon"
Case 4: GetBusinessName = "Child Care Services"
Case 5: GetBusinessName = "Construction Contractor"
Case 6: GetBusinessName = "Debt Collection Agency"
Case 7: GetBusinessName = "Electrician"
Case 8: GetBusinessName = "Massage Therapist"
Case 9: GetBusinessName = "Plumber"
Case 10: GetBusinessName = "Restaurant"
Case 11: GetBusinessName = "Insurance Requirements"
Case 12: GetBusinessName = "New Hire Reporting Requirements"
Case 13: GetBusinessName = "State Tax Registration"
Case 14: GetBusinessName = "Workplace Poster Requirements"
End Select
End Function
Function GetLicenseCategory(licenseCategory As licenseCategory) As String
Select Case licenseCategory
Case 0
GetLicenseCategory = "doing business as"
Case 1
GetLicenseCategory = "entity filing"
Case 2
GetLicenseCategory = "employer requirements"
Case 3
GetLicenseCategory = "state licenses"
Case 4
GetLicenseCategory = "tax registration"
End Select
End Function
Function GetSpecialty(specialty As specialty) As String
Select Case specialty
Case 0: GetSpecialty = "general_purpose"
Case 1: GetSpecialty = "development"
Case 2: GetSpecialty = "exporting"
Case 3: GetSpecialty = "contractor"
Case 4: GetSpecialty = "green"
Case 5: GetSpecialty = "military"
Case 6: GetSpecialty = "minority"
Case 7: GetSpecialty = "woman"
Case 8: GetSpecialty = "disabled"
Case 9: GetSpecialty = "rural"
Case 10: GetSpecialty = "disaster"
End Select
End Function
Function GetIndustryType(industry As industryType) As String
Select Case industry
Case 0: GetIndustryType = "Agriculture"
Case 1: GetIndustryType = "Child Care"
Case 2: GetIndustryType = "Environmental Management"
Case 3: GetIndustryType = "Health Care"
Case 4: GetIndustryType = "Manufacturing"
Case 5: GetIndustryType = "Technology"
Case 6: GetIndustryType = "Tourism"
End Select
End Function
Function GetStateAbbr(stateAbbr As stateAbbr) As String
Select Case stateAbbr
Case 0: GetStateAbbr = "AL"
Case 1: GetStateAbbr = "AK"
Case 2: GetStateAbbr = "AS"
Case 3: GetStateAbbr = "AZ"
Case 4: GetStateAbbr = "AR"
Case 5: GetStateAbbr = "CA"
Case 6: GetStateAbbr = "CO"
Case 7: GetStateAbbr = "CT"
Case 8: GetStateAbbr = "DE"
Case 9: GetStateAbbr = "DC"
Case 10: GetStateAbbr = "FM"
Case 11: GetStateAbbr = "FL"
Case 12: GetStateAbbr = "GA"
Case 13: GetStateAbbr = "GU"
Case 14: GetStateAbbr = "HI"
Case 15: GetStateAbbr = "ID"
Case 16: GetStateAbbr = "IL"
Case 17: GetStateAbbr = "IN"
Case 18: GetStateAbbr = "IA"
Case 19: GetStateAbbr = "KS"
Case 20: GetStateAbbr = "KY"
Case 21: GetStateAbbr = "LA"
Case 22: GetStateAbbr = "ME"
Case 23: GetStateAbbr = "MH"
Case 24: GetStateAbbr = "MD"
Case 25: GetStateAbbr = "MA"
Case 26: GetStateAbbr = "MI"
Case 27: GetStateAbbr = "MN"
Case 28: GetStateAbbr = "MS"
Case 29: GetStateAbbr = "MO"
Case 30: GetStateAbbr = "MT"
Case 31: GetStateAbbr = "NE"
Case 32: GetStateAbbr = "NV"
Case 33: GetStateAbbr = "NH"
Case 34: GetStateAbbr = "NJ"
Case 35: GetStateAbbr = "NM"
Case 36: GetStateAbbr = "NY"
Case 37: GetStateAbbr = "NC"
Case 38: GetStateAbbr = "ND"
Case 39: GetStateAbbr = "MP"
Case 40: GetStateAbbr = "OH"
Case 41: GetStateAbbr = "OK"
Case 42: GetStateAbbr = "OR"
Case 43: GetStateAbbr = "PW"
Case 44: GetStateAbbr = "PA"
Case 45: GetStateAbbr = "PR"
Case 46: GetStateAbbr = "RI"
Case 47: GetStateAbbr = "SC"
Case 48: GetStateAbbr = "SD"
Case 49: GetStateAbbr = "TN"
Case 50: GetStateAbbr = "TX"
Case 51: GetStateAbbr = "UT"
Case 52: GetStateAbbr = "VT"
Case 53: GetStateAbbr = "VI"
Case 54: GetStateAbbr = "VA"
Case 55: GetStateAbbr = "WA"
Case 56: GetStateAbbr = "WV"
Case 57: GetStateAbbr = "WI"
Case 58: GetStateAbbr = "WY"
End Select
End Function
Function GetEmptyArrayPosition(arr() As String) As Long
' pass in 2D String array, returns first empty position
Dim i As Long
Dim tempString As String
' loop through first position of array
' until empty row is found
Do
i = i + 1
tempString = arr(i, 1)
If Len(tempString) = 0 Then
GetEmptyArrayPosition = i
Exit Function
End If
Loop Until i = UBound(arr)
End Function
The MSXML helper functions should also be included in the same project.
Enum Sections
The following Enums should be pasted into a standard module in the same project as the business.gov API methods.
Public Enum businessType General_Business_Licenses Auto_Dealership Barber_Shop Beauty_Salon Child_Care_Services Construction_Contractor Debt_Collection_Agency Electrician Massage_Therapist Plumber Restaurant Insurance_Requirements New_Hire_Reporting_Requirements State_Tax_Registration Workplace_Poster_Requirements End Enum Public Enum licenseCategory doing_business_as entity_filing employer_requirements state_licenses tax_registration End Enum Public Enum specialty general_purpose development exporting contractor green military minority woman disabled rural disaster End Enum Public Enum industryType Agriculture Child_Care Environmental_Management Health_Care Manufacturing Technology Tourism End Enum Public Enum stateAbbr ALABAMA ALASKA AMERICAN_SAMOA ARIZONA ARKANSAS CALIFORNIA COLORADO CONNECTICUT DELAWARE DISTRICTOFCOLUMBIA MICRONESIA FLORIDA GEORGIA GUAM HAWAII IDAHO ILLINOIS INDIANA IOWA KANSAS KENTUCKY LOUISIANA MAINE MARSHALL_ISLANDS MARYLAND MASSACHUSETTS MICHIGAN MINNESOTA MISSISSIPPI MISSOURI MONTANA NEBRASKA NEVADA NEW_HAMPSHIRE NEW_JERSEY NEW_MEXICO NEW_YORK NORTH_CAROLINA NORTH_DAKOTA NORTHERN_MARIANA_ISLANDS OHIO OKLAHOMA OREGON PALAU PENNSYLVANIA PUERTO_RICO RHODE_ISLAND SOUTH_CAROLINA SOUTH_DAKOTA TENNESSEE TEXAS UTAH VERMONT VIRGIN_ISLANDS VIRGINIA WASHINGTON WEST_VIRGINIA WISCONSIN WYOMING End Enum
