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.
Like many of the other web API code samples found on this site (see Wordnik API, New York State Legislature API and Geonames API), these functions use XMLHTTP to fetch and cache a web query, then parse it for information using the MSXML Object Model, which is returned to the calling procedure.
You'll also need to include the code from the Enum Section and the Helper Functions in order for these functions to work.
There is a LOT of code on this page, but most of the methods are very similar to each other. And I did have to jump through a few hoops to solve a particular problem.
Loans & Grants Search API
Get list of Federal Programs
The following function will return all the small business financing programs available from the Federal government.
Function GetFederalPrograms(Optional forceRequery As Boolean = False) As String()
' http://www.sba.gov/content/loans-grants-search-api-federal-program-method
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 grantLoans As Object ' MSXML2.IXMLDOMNodeList
Dim grantLoan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Const TEMP_FILENAME As String = "FederalPrograms"
Const XML_FILE_EXTENSION As String = ".xml"
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & XML_FILE_EXTENSION
If (Len(Dir(tempFile)) = 0 Or forceRequery) Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/federal.xml", 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 grantLoans = GetChildNodes(xmlDocRoot)
' number of data nodes
numRows = grantLoans.Length
' number of data points in first (and presumably all) nodes
numCols = grantLoans.item(0).childNodes.Length
' resize array
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set grantLoan = grantLoans.item(i - 1)
For j = 1 To numCols
tempString(i, j) = grantLoan.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetFederalPrograms = tempString
End Function
Sample Usage
The following procedure will return all the Federal loan and grant programs and then iterate through the resulting array. You can also assign the array directly to a listbox.
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetFederalPrograms
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
Get State Financing Programs
State loan and grant programs for a given state may be returned using this function. The function uses a custom Enum (see the Enum Section for the stateAbbr Enum) and another function to convert the Enum to a string for the API call (see Helper Functions for the GetStateAbbr function).
Function GetStatePrograms(stateAbbr As stateAbbr, _
Optional forceRequery As Boolean = False) As String()
' http://www.sba.gov/content/loans-grants-search-api-programs-specific-state-method
' Returns all small business financing programs sponsored by state
' government agencies and select non-profit and commercial organizations.
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 grantLoans As Object ' MSXML2.IXMLDOMNodeList
Dim grantLoan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
Const TEMP_FILENAME As String = "StatePrograms"
Const XML_FILE_EXTENSION As String = ".xml"
state = GetStateAbbr(stateAbbr)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If (Len(Dir(tempFile)) = 0 Or forceRequery) Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", _
"http://api.sba.gov/loans_grants/state_financing_for/" & 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 grantLoans = GetChildNodes(xmlDocRoot)
' number of data nodes
numRows = grantLoans.Length
' number of data points in first (and presumably all) nodes
numCols = grantLoans.item(0).childNodes.Length
' resize array
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set grantLoan = grantLoans.item(i - 1)
For j = 1 To numCols
tempString(i, j) = grantLoan.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetStatePrograms = tempString
End Function
Sample Usage
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetStatePrograms(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
End Sub
This function will return both State AND Federal loan and grant programs for a given state.
Function GetFederalAndStatePrograms(stateAbbr As stateAbbr, _
Optional forceRequery As Boolean = False) As String()
' http://www.sba.gov/content/loans-grants-search-api-federal-and-state-specific-method
' Returns all small business financing programs sponsored by federal and state
' government agencies and selected non-profit and commercial organizations.
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 grantLoans As Object ' MSXML2.IXMLDOMNodeList
Dim grantLoan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long
Dim state As String
Const TEMP_FILENAME As String = "FederalAndStatePrograms"
Const XML_FILE_EXTENSION As String = ".xml"
state = GetStateAbbr(stateAbbr)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & state & XML_FILE_EXTENSION
If (Len(Dir(tempFile)) = 0 Or forceRequery) Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/federal_and_state_financing_for/" & _
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 grantLoans = GetChildNodes(xmlDocRoot)
' number of data nodes
numRows = grantLoans.Length
' number of data points in first (and presumably all) nodes
numCols = grantLoans.item(0).childNodes.Length
' resize array
ReDim tempString(1 To numRows, 1 To numCols)
For i = 1 To numRows
Set grantLoan = grantLoans.item(i - 1)
For j = 1 To numCols
tempString(i, j) = grantLoan.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetFederalAndStatePrograms = tempString
End Function
Sample Usage
This sample procedure returns all the state and federal financing programs available in New York State.
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetFederalAndStatePrograms(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
End Sub
Get Programs By Industry
This function returns all loan and grant programs by industry. Here are the industries:
- Agriculture
- Child Care
- Environmental Management
- Health Care
- Manufacturing
- Technology
- Tourism
These are passed to the function as a custom Enum.
This function presented a unique problem which I was not able to solve by a traditional loop. Because of the way the XML results are returned, I used four different arrays to collect the data from each node set, then put them together into a larger array.
My advice is to step through the code and look at the raw XML to see how the code works.
Function GetProgramsByIndustry(industry As industryType, _
Optional forceRequery As Boolean = False) As String()
' http://www.sba.gov/content/loans-grants-search-api-industry-method
' Returns all small business financing programs for a specific industry in all
' 54 states and territories (when available).
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim tempLoans() As String
Dim tempGrants() As String
Dim ventureCapital() As String
Dim tempTaxIncentive() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim loanResults As Object ' MSXML2.IXMLDOMNode
Dim subNodes As Object ' MSXML2.IXMLDOMNodeList
Dim loan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long, k As Long, h As Long, g As Long
Dim industryName As String
Dim maxArraySize As Long
Dim maxColumns As Long
Dim nextArrayPosition As Long
Const TEMP_FILENAME As String = "ProgramsByIndustry"
Const XML_FILE_EXTENSION As String = ".xml"
industryName = GetIndustryType(industry)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & industryName & XML_FILE_EXTENSION
If (Len(Dir(tempFile)) = 0 Or forceRequery) Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/nil/for_profit/" & industryName & "/nil.xml", 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 results = GetChildNodes(xmlDocRoot)
' get array max size and max number of columns
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
' number of columns in the array is the largest number of nodes in all node sets
' if node set has zero nodes, ignore
If loanResults.childNodes.Length > 0 Then
maxColumns = Application.max(loanResults.childNodes.item(0).childNodes.Length, maxColumns)
' number of rows in the array is the sum of all available nodes
maxArraySize = maxArraySize + loanResults.childNodes.Length
End If
Next i
' resize array
ReDim tempString(1 To maxArraySize, 1 To maxColumns)
' create separate arrays for each node set
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
Select Case loanResults.nodeName
Case "loan_results"
' grab loans and put into temp array
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempLoans(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempLoans(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempLoans)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempLoans(h, g)
Next g
Next h
End If
Case "venture_capital_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempGrants(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempGrants(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempGrants)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempGrants(h, g)
Next g
Next h
End If
Case "tax_incentive_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim ventureCapital(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
ventureCapital(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(ventureCapital)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = ventureCapital(h, g)
Next g
Next h
End If
Case "grant_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempTaxIncentive(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempTaxIncentive(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempTaxIncentive)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempTaxIncentive(h, g)
Next g
Next h
End If
End Select
Next i
GetProgramsByIndustry = tempString
End Function
Sample Usage
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetProgramsByIndustry(Child_Care)
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
Return programs by specialty
Programs may also be filtered by specialty. The following specialties are available:
- general_purpose
- development
- exporting
- contractor
- green
- military
- minority
- woman
- disabled
- rural
- disaster
Function GetProgramsBySpecialty(specialty As specialty) As String()
' http://www.sba.gov/content/loans-grants-search-api-specialty-method
' Returns small business special financing programs for certain business owner
' groups (e.g., women, veterans, minorities, etc.); or business activities
' (e.g., export, energy efficiency, disaster assistance, etc.).
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim tempLoans() As String
Dim tempGrants() As String
Dim ventureCapital() As String
Dim tempTaxIncentive() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim loanResults As Object ' MSXML2.IXMLDOMNode
Dim subNodes As Object ' MSXML2.IXMLDOMNodeList
Dim loan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long, k As Long, h As Long, g As Long
Dim specialtyName As String
Dim maxArraySize As Long
Dim maxColumns As Long
Dim nextArrayPosition As Long
Const TEMP_FILENAME As String = "ProgramsBySpecialty"
Const XML_FILE_EXTENSION As String = ".xml"
specialtyName = GetSpecialty(specialty)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & specialtyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/nil/for_profit/nil/" & specialtyName & 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 results = GetChildNodes(xmlDocRoot)
' get array max size and max number of columns
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
' number of columns in the array is the largest number of nodes in all node sets
' if node set has zero nodes, ignore
If loanResults.childNodes.Length > 0 Then
maxColumns = Application.max(loanResults.childNodes.item(0).childNodes.Length, maxColumns)
' number of rows in the array is the sum of all available nodes
maxArraySize = maxArraySize + loanResults.childNodes.Length
End If
Next i
' resize array
ReDim tempString(1 To maxArraySize, 1 To maxColumns)
' create separate arrays for each node set
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
Select Case loanResults.nodeName
Case "loan_results"
' grab loans and put into temp array
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempLoans(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempLoans(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempLoans)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempLoans(h, g)
Next g
Next h
End If
Case "venture_capital_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempGrants(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempGrants(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempGrants)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempGrants(h, g)
Next g
Next h
End If
Case "tax_incentive_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim ventureCapital(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
ventureCapital(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(ventureCapital)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = ventureCapital(h, g)
Next g
Next h
End If
Case "grant_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempTaxIncentive(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempTaxIncentive(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempTaxIncentive)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempTaxIncentive(h, g)
Next g
Next h
End If
End Select
Next i
GetProgramsBySpecialty = tempString
End Function
Sample Usage
Let's return all of the loan and grant programs available for small business to "go green".
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetProgramsBySpecialty(green)
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
Filter programs by industry and specialty
We can filter programs even further, by specifying both industry and speciality. For a list of specialties, see GetProgramsBySpecialty. A list of industries may be found at GetProgramsByIndustry.
Function GetProgramsByIndustryAndSpecialty(industry As industryType, specialty As specialty) As String()
' http://www.sba.gov/content/loans-grants-search-api-industry-and-specialty-method
' Returns financing programs for specific industries AND specific business groups (e.g.,
' women, veterans, minorities, etc.); or business activities (e.g., export, energy efficiency,
' disaster assistance, etc.).
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim tempLoans() As String
Dim tempGrants() As String
Dim ventureCapital() As String
Dim tempTaxIncentive() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim loanResults As Object ' MSXML2.IXMLDOMNode
Dim subNodes As Object ' MSXML2.IXMLDOMNodeList
Dim loan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long, k As Long, h As Long, g As Long
Dim specialtyName As String
Dim industryName As String
Dim maxArraySize As Long
Dim maxColumns As Long
Dim nextArrayPosition As Long
Const TEMP_FILENAME As String = "ProgramsByIndustryAndSpecialty"
Const XML_FILE_EXTENSION As String = ".xml"
specialtyName = GetSpecialty(specialty)
industryName = GetIndustryType(industry)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & industryName & specialtyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/nil/for_profit/" & industryName & "/" & specialtyName & 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 results = GetChildNodes(xmlDocRoot)
' get array max size and max number of columns
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
' number of columns in the array is the largest number of nodes in all node sets
' if node set has zero nodes, ignore
If loanResults.childNodes.Length > 0 Then
maxColumns = Application.max(loanResults.childNodes.item(0).childNodes.Length, maxColumns)
' number of rows in the array is the sum of all available nodes
maxArraySize = maxArraySize + loanResults.childNodes.Length
End If
Next i
' resize array
ReDim tempString(1 To maxArraySize, 1 To maxColumns)
' create separate arrays for each node set
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
Select Case loanResults.nodeName
Case "loan_results"
' grab loans and put into temp array
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempLoans(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempLoans(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempLoans)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempLoans(h, g)
Next g
Next h
End If
Case "venture_capital_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempGrants(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempGrants(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempGrants)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempGrants(h, g)
Next g
Next h
End If
Case "tax_incentive_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim ventureCapital(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
ventureCapital(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(ventureCapital)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = ventureCapital(h, g)
Next g
Next h
End If
Case "grant_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempTaxIncentive(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempTaxIncentive(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempTaxIncentive)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempTaxIncentive(h, g)
Next g
Next h
End If
End Select
Next i
GetProgramsByIndustryAndSpecialty = tempString
End Function
Sample Usage
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetProgramsByIndustryAndSpecialty(Child_Care, general_purpose)
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
Filter programs by state and industry
You may also filter available financing programs by state and industry. For a list of industries, go to GetProgramsByIndustry.
Function GetProgramsByStateAndIndustry(stateAbbr As stateAbbr, _
industry As industryType) As String()
' http://www.sba.gov/content/loans-grants-search-api-state-and-industry-method
' Returns all small business financing programs for a specific industry in a specific state.
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim tempLoans() As String
Dim tempGrants() As String
Dim ventureCapital() As String
Dim tempTaxIncentive() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim loanResults As Object ' MSXML2.IXMLDOMNode
Dim subNodes As Object ' MSXML2.IXMLDOMNodeList
Dim loan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long, k As Long, h As Long, g As Long
Dim state As String
Dim industryName As String
Dim maxArraySize As Long
Dim maxColumns As Long
Dim nextArrayPosition As Long
Const TEMP_FILENAME As String = "ProgramsByStateAndIndustry"
Const XML_FILE_EXTENSION As String = ".xml"
state = GetStateAbbr(stateAbbr)
industryName = GetIndustryType(industry)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & state & industryName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/" & state & "/for_profit/" & industryName & "/nil.xml", 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 results = GetChildNodes(xmlDocRoot)
' get array max size and max number of columns
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
' number of columns in the array is the largest number of nodes in all node sets
' if node set has zero nodes, ignore
If loanResults.childNodes.Length > 0 Then
maxColumns = Application.max(loanResults.childNodes.item(0).childNodes.Length, maxColumns)
' number of rows in the array is the sum of all available nodes
maxArraySize = maxArraySize + loanResults.childNodes.Length
End If
Next i
' resize array
ReDim tempString(1 To maxArraySize, 1 To maxColumns)
' create separate arrays for each node set
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
Select Case loanResults.nodeName
Case "loan_results"
' grab loans and put into temp array
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempLoans(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempLoans(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempLoans)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempLoans(h, g)
Next g
Next h
End If
Case "venture_capital_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempGrants(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempGrants(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempGrants)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempGrants(h, g)
Next g
Next h
End If
Case "tax_incentive_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim ventureCapital(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
ventureCapital(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(ventureCapital)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = ventureCapital(h, g)
Next g
Next h
End If
Case "grant_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempTaxIncentive(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempTaxIncentive(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempTaxIncentive)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempTaxIncentive(h, g)
Next g
Next h
End If
End Select
Next i
GetProgramsByStateAndIndustry = tempString
End Function
Sample Usage
This procedure will return all of the manufacturing-related loans and grants available to small businesses in the state of Arizona.
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetProgramsByStateAndIndustry(ARIZONA, Manufacturing)
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
Return programs by state and specialty
We can also filter programs by state and speciality. For a list of specialties, see GetProgramsBySpecialty.
Function GetProgramsByStateAndSpecialty(stateAbbr As stateAbbr, specialty As specialty) As String()
' http://www.sba.gov/content/loans-grants-search-api-state-and-specialty-method
' Returns specialized financing programs for small businesses in a specific state. Specialized
' financing programs include those for certain business owner groups (e.g., women,
' veterans, minorities, etc.); or business activities (e.g., export, energy efficiency, disaster
' assistance, etc.).
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim tempLoans() As String
Dim tempGrants() As String
Dim ventureCapital() As String
Dim tempTaxIncentive() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim loanResults As Object ' MSXML2.IXMLDOMNode
Dim subNodes As Object ' MSXML2.IXMLDOMNodeList
Dim loan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long, k As Long, h As Long, g As Long
Dim state As String
Dim specialtyName As String
Dim maxArraySize As Long
Dim maxColumns As Long
Dim nextArrayPosition As Long
Const TEMP_FILENAME As String = "ProgramsByStateAndSpecialty"
Const XML_FILE_EXTENSION As String = ".xml"
state = GetStateAbbr(stateAbbr)
specialtyName = GetSpecialty(specialty)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & state & specialtyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/" & state & "/for_profit/nil/" & specialtyName & 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 results = GetChildNodes(xmlDocRoot)
' get array max size and max number of columns
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
' number of columns in the array is the largest number of nodes in all node sets
' if node set has zero nodes, ignore
If loanResults.childNodes.Length > 0 Then
maxColumns = Application.max(loanResults.childNodes.item(0).childNodes.Length, maxColumns)
' number of rows in the array is the sum of all available nodes
maxArraySize = maxArraySize + loanResults.childNodes.Length
End If
Next i
' resize array
ReDim tempString(1 To maxArraySize, 1 To maxColumns)
' create separate arrays for each node set
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
Select Case loanResults.nodeName
Case "loan_results"
' grab loans and put into temp array
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempLoans(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempLoans(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempLoans)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempLoans(h, g)
Next g
Next h
End If
Case "venture_capital_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempGrants(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempGrants(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempGrants)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempGrants(h, g)
Next g
Next h
End If
Case "tax_incentive_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim ventureCapital(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
ventureCapital(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(ventureCapital)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = ventureCapital(h, g)
Next g
Next h
End If
Case "grant_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempTaxIncentive(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempTaxIncentive(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempTaxIncentive)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempTaxIncentive(h, g)
Next g
Next h
End If
End Select
Next i
GetProgramsByStateAndSpecialty = tempString
End Function
Sample Usage
This sample procedure will return general purpose financing programs available for small businesses in Arizona.
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetProgramsByStateAndSpecialty(ARIZONA, general_purpose)
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
Return programs filtered by state, industry and specialty
Programs may also be filtered by all three criteria: state, industry and specialty. For a list of specialties, see GetProgramsBySpecialty. A list of industries may be found at GetProgramsByIndustry.
Function GetProgramsByStateIndustryAndSpecialty(stateAbbr As stateAbbr, industry As industryType, specialty As specialty) As String()
' http://www.sba.gov/content/loans-grants-search-api-state-industry-and-specialty-method
' Returns industry-specific and specialized financing programs for small businesses in a specific
' state. Specialized financing programs include those for certain business owner groups (e.g.,
' women, veterans, minorities, etc.); or business activities (e.g., export, energy efficiency,
' disaster assistance, etc.).
Dim xml As Object ' MSXML2.XMLHTTP
Dim tempFile As String
Dim tempString() As String
Dim tempLoans() As String
Dim tempGrants() As String
Dim ventureCapital() As String
Dim tempTaxIncentive() As String
Dim result As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim xmlDocRoot As Object ' MSXML2.IXMLDOMNode
Dim results As Object ' MSXML2.IXMLDOMNodeList
Dim loanResults As Object ' MSXML2.IXMLDOMNode
Dim subNodes As Object ' MSXML2.IXMLDOMNodeList
Dim loan As Object ' MSXML2.IXMLDOMNode
Dim numRows As Long, numCols As Long
Dim i As Long, j As Long, k As Long, h As Long, g As Long
Dim state As String
Dim industryName As String
Dim specialtyName As String
Dim maxArraySize As Long
Dim maxColumns As Long
Dim nextArrayPosition As Long
Const TEMP_FILENAME As String = "ProgramsByStateIndustryAndSpecialty"
Const XML_FILE_EXTENSION As String = ".xml"
state = GetStateAbbr(stateAbbr)
specialtyName = GetSpecialty(specialty)
industryName = GetIndustryType(industry)
' if XML file exists, don't requery website
tempFile = environ("temp") & "\" & TEMP_FILENAME & state & industryName & specialtyName & XML_FILE_EXTENSION
If Len(Dir(tempFile)) = 0 Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://api.sba.gov/loans_grants/" & state & "/for_profit/" & industryName & "/" & specialtyName & 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 results = GetChildNodes(xmlDocRoot)
' get array max size and max number of columns
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
' number of columns in the array is the largest number of nodes in all node sets
' if node set has zero nodes, ignore
If loanResults.childNodes.Length > 0 Then
maxColumns = Application.max(loanResults.childNodes.item(0).childNodes.Length, maxColumns)
' number of rows in the array is the sum of all available nodes
maxArraySize = maxArraySize + loanResults.childNodes.Length
End If
Next i
' resize array
ReDim tempString(1 To maxArraySize, 1 To maxColumns)
' create separate arrays for each node set
For i = 1 To results.Length
Set loanResults = results.item(i - 1)
Select Case loanResults.nodeName
Case "loan_results"
' grab loans and put into temp array
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempLoans(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempLoans(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempLoans)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempLoans(h, g)
Next g
Next h
End If
Case "venture_capital_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempGrants(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempGrants(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempGrants)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempGrants(h, g)
Next g
Next h
End If
Case "tax_incentive_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim ventureCapital(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
ventureCapital(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(ventureCapital)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = ventureCapital(h, g)
Next g
Next h
End If
Case "grant_results"
Set subNodes = GetChildNodes(loanResults)
If subNodes.Length > 0 Then
ReDim tempTaxIncentive(1 To subNodes.Length, 1 To maxColumns)
For j = 1 To subNodes.Length
Set loan = subNodes.item(j - 1)
For k = 1 To loan.childNodes.Length
tempTaxIncentive(j, k) = loan.childNodes(k - 1).nodeTypedValue
Next k
Next j
' populate main array with values from temp array
' calculate next empty position in main array
nextArrayPosition = GetEmptyArrayPosition(tempString)
For h = 1 To UBound(tempTaxIncentive)
For g = 1 To maxColumns
tempString(h + (nextArrayPosition - 1), g) = tempTaxIncentive(h, g)
Next g
Next h
End If
End Select
Next i
GetProgramsByStateIndustryAndSpecialty = tempString
End Function
Sample Usage
This sample procedure returns all the small business financing programs available in the state of Arizona for manufacturing businesses owned by minorities.
Sub TestBusinessGov()
Dim results() As String
Dim i As Long, j As Long
results = GetProgramsByStateIndustryAndSpecialty(ARIZONA, Manufacturing, minority)
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 placed 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
