You are here: Home » Excel VBA » Periodic Table of Elements fetching with XMLHTTP

Periodic Table of Elements fetching with XMLHTTP

The Periodic Table of Elements displays the known chemical elements.

periodic table


We could list all the element information onto a worksheet (since it doesn't change very often) and return it from there, but web fetching is more fun.

Here is a series of functions that returns information about the Periodic Table from webservicex.net, a website that lists several different web APIs. We use XMLHTTP to request information from the available methods.

There are four functions, along with a set of common helper functions (see below). Each one saves XML files to the local temp folder.

1: GetAtomicInfo

The GetAtomicInfo Function returns an array of information about a given element. Specifically, it returns the atomic number, element name, atomic symbol, atomic weight, boiling point, electronegativity, atomic radius, melting point and density for any element on the Periodic Table. It is the main function which the others depend on — the functions GetAtomicWeight and GetElementSymbol will look for the output of GetAtomicInfo before performing their own web query, because that web query will contain the same information.

First we perform the web query and save the result as a XML file in the temp folder. Using the MSXML object model, we load the XML into its own document and parse it into an array. Since only one node is returned, we only need to go down one level.

It will also check if the query was already run (by looking in the temp folder for an existing XML file) and just reload that file instead of doing the (relatively slower) web query again.

Function GetAtomicInfo(elementName As String) As String()
' http://www.webservicex.net/WCF/ServiceDetails.aspx?SID=37

' returns:
' GetAtomicInfo(0) = Atomic Number
' GetAtomicInfo(1) = Element Name
' GetAtomicInfo(2) = Symbol
' GetAtomicInfo(3) = Atomic Weight
' GetAtomicInfo(4) = Boiling Point
' GetAtomicInfo(5) = Electronegativity
' GetAtomicInfo(6) = Atomic Radius
' GetAtomicInfo(7) = Melting Point
' GetAtomicInfo(8) = Density

Dim xml As Object
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim numRows As Long
Dim numCols As Long
Dim xmlDoc As Object
Dim xmlDocRoot As Object
Dim newDataSet As Object

Const XML_FILE_EXTENSION As String = ".xml"

  ' if XML file exists, don't requery website
  tempFile = environ("temp") & "\" & elementName & "AtomicInfo" & XML_FILE_EXTENSION

  If Len(Dir(tempFile)) = 0 Then
    tempFile = environ("temp") & "\" & elementName & XML_FILE_EXTENSION

    If Len(Dir(tempFile)) = 0 Then

      Set xml = GetMSXML

      xml.Open "GET", _
"http://www.webservicex.net/periodictable.asmx/GetAtomicNumber?ElementName=" & elementName, False
      xml.Send

      result = xml.responsetext

      result = Replace(Replace(result, "<", "<"), ">", ">")

      ' save result as temp XML document
      tempFile = CreateFile(tempFile, result)

    End If

  End If

  ' load XML file into new XML document
  Set xmlDoc = GetDomDoc

  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 newDataSet = GetChildNodes(xmlDocRoot)

  ' put values into array
  tempString = Split(newDataSet.Item(0).nodeTypedValue, " ")

  GetAtomicInfo = tempString

  ' delete temp xml file
  '  Kill tempFile

End Function

There are four additional functions being used here, which you'll find at the bottom of this article.

  • CreateFile – creates the XML file by writing the web response to a file of your choice
  • LoadError – checks the XML Document Object for errors
  • GetRootNode – returns the root node of the XML document so we can begin parsing
  • GetChildNodes – returns the child nodes of whatever XML node is passed to it

Sample usage

Sub TestGetAtomicInfo()

Dim atomicInfo() As String
Dim elementName As String

  elementName = "Plutonium"

  atomicInfo = GetAtomicInfo(elementName)

  ' print the boiling point of Plutonium
  Debug.Print atomicInfo(4)

End Sub

2: GetElementSymbol

The GetElementSymbol function returns the atomic symbol for a given element. It will check for the output of GetAtomicInfo first. Otherwise it operates similarly to GetAtomicInfo.

Function GetElementSymbol(elementName As String) As String
' http://www.webservicex.net/WCF/ServiceDetails.aspx?SID=37

Dim xml As Object
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim numRows As Long
Dim numCols As Long
Dim xmlDoc As Object
Dim xmlDocRoot As Object
Dim newDataSet As Object
Dim fileExists As Boolean

Const XML_FILE_EXTENSION As String = ".xml"

  ' if XML file from GetAtomicInfo exists, don't requery website
  tempFile = environ("temp") & "\" & elementName & _
    "AtomicInfo" & XML_FILE_EXTENSION

  If Len(Dir(tempFile)) = 0 Then

    tempFile = environ("temp") & "\" & elementName & XML_FILE_EXTENSION

    If Len(Dir(tempFile)) = 0 Then

      Set xml = GetMSXML

      xml.Open "GET", _
       "http://www.webservicex.net/periodictable.asmx/GetElementSymbol?ElementName=" & _
         elementName, False
      xml.Send

      result = xml.responsetext

      result = Replace(Replace(result, "<", "<"), ">", ">")

      ' save result as temp XML document
      tempFile = CreateFile(tempFile, result)
    End If

  Else
    fileExists = True
  End If

  ' load XML file into new XML document
  Set xmlDoc = GetDomDoc

  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 newDataSet = GetChildNodes(xmlDocRoot)

  ' put values into array
  tempString = Split(newDataSet.Item(0).nodeTypedValue, " ")

  If fileExists Then
    GetElementSymbol = tempString(2)
  Else
    GetElementSymbol = tempString(0)
  End If

  ' delete temp xml file
  '  Kill tempFile

End Function

Sample usage

Sub TestGetElementSymbol()

Dim elementName As String

  elementName = "Plutonium"

  ' print the atomic symbol for Plutonium
  Debug.Print GetElementSymbol(elementName)

End Sub

3: GetElements

The GetElements symbol returns an array of all the elements in the Periodic Table in alphabetical order. This function can be used in conjunction with the others, for example you could get a list of all the elements, then get the atomic weight or atomic symbol for each.

Function GetElements() As String()
' http://www.webservicex.net/WCF/ServiceDetails.aspx?SID=37

Dim xml As Object
Dim result As String
Dim tempFile As String
Dim xmlDoc As Object
Dim xmlDocRoot As Object
Dim newDataSet As Object
Dim tables As Object
Dim table As Object
Dim tempString() As String
Dim i As Long

Const XML_FILE_EXTENSION As String = ".xml"

  ' if XML file exists, don't requery website
  tempFile = environ("temp") & "\GetElements" & XML_FILE_EXTENSION

  If Len(Dir(tempFile)) = 0 Then

    Set xml = GetMSXML

    xml.Open "GET", _
         "http://www.webservicex.net/periodictable.asmx/GetAtoms?", False
    xml.Send

    result = xml.responsetext

    result = Replace(Replace(result, "<", "<"), ">", ">")

    ' save result as temp XML document
    tempFile = CreateFile(tempFile, result)

  End If

  ' load XML file into new XML document
  Set xmlDoc = GetDomDoc

  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 newDataSet = GetChildNodes(xmlDocRoot)

  ' get second level nodes
  Set tables = newDataSet.Item(0).childNodes

  ' resize array
  ReDim tempString(1 To tables.Length)

  For i = 1 To tables.Length
    tempString(i) = tables.Item(i - 1).nodeTypedValue
  Next i

  GetElements = tempString

  ' delete temp xml file
  '  Kill tempFile

End Function

Sample usage

Sub TestGetElements()

Dim elements() As String
Dim i As Long

  elements = GetElements

  ' get the atomic symbol for each element
  For i = LBound(elements) To UBound(elements)
    Debug.Print GetElementSymbol(elements(i))
  Next i

End Sub

4: GetAtomicWeight

The GetAtomicWeight function returns the atomic weight for a given element. It first checks for the output of the GetAtomicInfo function, to avoid running the web query again. It works just like GetElementSymbol.

Function GetAtomicWeight(elementName As String) As Double
' http://www.webservicex.net/WCF/ServiceDetails.aspx?SID=37

Dim xml As Object
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim numRows As Long
Dim numCols As Long
Dim xmlDoc As Object
Dim xmlDocRoot As Object
Dim newDataSet As Object
Dim fileExists As Boolean

Const XML_FILE_EXTENSION As String = ".xml"

  ' if XML file from GetAtomicInfo exists, don't requery website
  tempFile = environ("temp") & "\" & elementName & "AtomicInfo" & XML_FILE_EXTENSION

  If Len(Dir(tempFile)) = 0 Then

    tempFile = environ("temp") & "\" & elementName & XML_FILE_EXTENSION

    If Len(Dir(tempFile)) = 0 Then

      Set xml = GetMSXML

      xml.Open "GET", _
               "http://www.webservicex.net/periodictable.asmx/GetAtomicWeight?ElementName=" & _
               elementName, False
      xml.Send

      result = xml.responsetext

      result = Replace(Replace(result, "<", "<"), ">", ">")

      ' save result as temp XML document
      tempFile = CreateFile(tempFile, result)
    End If

  Else
    fileExists = True
  End If

  ' load XML file into new XML document
  Set xmlDoc = GetDomDoc

  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 newDataSet = GetChildNodes(xmlDocRoot)

  ' put values into array
  tempString = Split(newDataSet.Item(0).nodeTypedValue, " ")

  If fileExists Then
    GetAtomicWeight = tempString(3)
  Else
    GetAtomicWeight = tempString(0)
  End If

  ' delete temp xml file
  '  Kill tempFile

End Function

Sample usage

Sub TestGetAtomicWeight()

Dim elementName As String

  elementName = "Plutonium"

  ' print the atomic weight for Plutonium
  Debug.Print GetAtomicWeight(elementName)

End Sub

Additional Functions

These functions should be pasted into the same project as the above functions, either in the same standard module or into their own 'helper functions' module.

Make sure your system meets the requirements for running the code found on this page.

Site last updated: May 21, 2013

excel school learn dashboards