UPC Database API

UPC Database is a list of user-submitted UPC codes containing information such as:

• product name
• price
• manufacturer

Of course there is an API so we can download UPC information programmatically. An API key is required; I have a key but in the sample code below it is removed. Visit the API page to register for a key.

Check if UPC is valid

Since a UPC code is either 12 or 13 digits (EAN), we could check for format validity like this:

Function IsValidFormat(upcCode As String) As Boolean
  IsValidFormat = ((Len(upcCode) >= 12) And (Len(upcCode) <= 13))
End Function

But we want more than just a well-formed UPC code, we want one that is actually found in the UPC Database. Unfortunately, there is no API method for checking if a UPC code is in the database. We simply have to call the retrieval method and hope that we got it right. We can, however, cache this response and use it later.

The following code uses the MSXML class module to call a web API and return a response back to VBA. It merely checks if the given UPC code is found in the database.

First, paste the following at the top of a standard module:

Const API_KEY As String = "your API key here"
Const BASE_URL As String = "http://www.upcdatabase.org/api/xml/"

Paste the following function into a standard module in the same project:

Function IsUPCValid(upcCode As String, _
    Optional forceRequery As Boolean) As Boolean

  Dim msxml As clsMSXML
  Dim xml As Object  ' MSXML2.XMLHTTP60
  Dim domDoc As Object  ' MSXML2.DOMDocument60
  Dim docRoot As Object  ' MSXML2.IXMLDOMNode
  Dim tempFolder As String
  Dim tempFile As String
  Dim result As String

  Const XML_FILE_EXTENSION As String = ".xml"

  ' get filepath to temp file for caching
  tempFolder = Environ("temp") & "\"
  tempFile = tempFolder & upcCode & XML_FILE_EXTENSION

  Set msxml = New clsMSXML

  ' if response is not cached already, or we asked the
  ' function to query the API anyway, then requery
  If Len(Dir(tempFile)) = 0 Or forceRequery Then
    Set xml = msxml.GetMSXML
    result = msxml.GetResponse(xml, HTTP_GET, _
        BASE_URL & "/" & API_KEY & "/" & upcCode, False)

    ' cache API response
    msxml.CreateFile tempFile, result
  End If

  ' at this point, tempfile either already existed,
  ' or was just created
  ' load tempfile into MSXML DOMDocument
  Set domDoc = msxml.GetDomDoc
  domDoc.Load tempFile
  ' if an error occurred, exit
  If msxml.LoadError(domDoc) Then
    Exit Function
  End If

  Set docRoot = msxml.GetRootNode(domDoc)

  IsUPCValid = (msxml.GetNode(docRoot, 1).nodeTypedValue = "true")

End Function

We make a standard API call and cache the response. However, we only check if the valid node is equal to
true

.

Lookup UPC information

Now we want to actually return the UPC code information. The function is almost the same except we loop through the API response and assign each node to an array element.

Function GetUPCInfo(upcCode As String, _
    Optional forceRequery As Boolean) As String()

  Dim msxml As clsMSXML
  Dim xml As Object  ' MSXML2.XMLHTTP60
  Dim domDoc As Object  ' MSXML2.DOMDocument60
  Dim docRoot As Object  ' MSXML2.IXMLDOMNode
  Dim tempFolder As String
  Dim tempFile As String
  Dim tempString() As String
  Dim result As String
  Dim i As Long

  Const XML_FILE_EXTENSION As String = ".xml"

  ' get filepath to temp file for caching
  tempFolder = Environ("temp") & "\"
  tempFile = tempFolder & upcCode & XML_FILE_EXTENSION

  Set msxml = New clsMSXML

  ' if response is not cached already, or we asked the
  ' function to query the API anyway, then requery
  If Len(Dir(tempFile)) = 0 Or forceRequery Then
    Set xml = msxml.GetMSXML
    result = msxml.GetResponse(xml, HTTP_GET, _
      BASE_URL & "/" & API_KEY & "/" & upcCode, False)

    ' cache API response
    msxml.CreateFile tempFile, result
  End If

  ' at this point, tempfile either already existed,
  ' or was just created
  ' load tempfile into MSXML DOMDocument
  Set domDoc = msxml.GetDomDoc
  domDoc.Load tempFile
  ' if an error occurred, exit
  If msxml.LoadError(domDoc) Then
    Exit Function
  End If

  Set docRoot = msxml.GetRootNode(domDoc)

  ' allocate array elements
  ReDim tempString(1 To docRoot.childNodes.length)

  For i = 1 To docRoot.childNodes.length
    tempString(i) = msxml.GetNode(docRoot, i).nodeTypedValue
  Next i

  GetUPCInfo = tempString

End Function

Sample Usage

Since the code to check if a UPC is valid caches the API response, we can leverage that code when retrieving UPC information.

Sub GetUPC()

  Dim upcCode As String
  Dim result() As String
  Dim i As Long

  upcCode = "0111222333444"

  If IsUPCValid(upcCode) Then
    result = GetUPCInfo(upcCode)
  End If

  For i = LBound(result) To UBound(result)
    Debug.Print result(i)
  Next i

End Sub

See a previous post for how to turn this function into a UDF that prints all the array elements to the worksheet.