Using VBA macro in Excel to retrieve images of chemical structures from the NCI Chemical Identifier Resolver

Question

Based on the code given at this site (see below) I would like to adapt some VBA Excel macros to convert chemical names to chemical structures in Excel using the NCI Chemical Identifier Resolver at http://cactus.nci.nih.gov/chemical/structure

In particular, I would like to extend the code to have an additional function to return me an image (GIF) of the structure, where the image of the structure should be retrieved from

  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image", False

which should then be saved in the Excel sheet at the location from where the formula is called (possibly also resizing the row to fit the image that is returned). Any thought how this could be achieved?

Any advice would be much appreciated!

cheers, Tom

Private Function strip(ByVal str As String) As String
  Dim last

  For i = 1 To Len(str) Step 1
    If Asc(Mid(str, i, 1)) < 33 Then
      last = i
    End If
  Next i

  If last > 0 Then
    strip = Mid(str, 1, last - 1)
  Else
    strip = str
  End If
End Function

Public Function getSMILES(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 2000, 2000, 2000, 2000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/smiles", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getSMILES = strip(XMLhttp.responsetext)
  Else
    getSMILES = ""
  End If
End Function
Public Function getInChIKey(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/stdinchikey", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getInChIKey = Mid(strip(XMLhttp.responsetext), 10)
  Else
    getInChIKey = ""
  End If
End Function
Public Function getIUPAC(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/iupac_name", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getIUPAC = strip(XMLhttp.responsetext)
  Else
    getIUPAC = ""
  End If
End Function
Public Function getCAS(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/cas", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getCAS = Mid(XMLhttp.responsetext, 1, InStr(XMLhttp.responsetext, Chr(10)) - 1)
  Else
    getCAS = ""
  End If
End Function
Public Function getCASnrs(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/cas", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getCASnrs = Replace(XMLhttp.responsetext, Chr(10), "; ")
  Else
    getCASnrs = ""
  End If
End Function
Public Function getSYNONYMS(ByVal name As String) As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  XMLhttp.Open "GET", "http://cactus.nci.nih.gov/chemical/structure/" + name + "/names", False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
    getSYNONYMS = Replace(XMLhttp.responsetext, Chr(10), "; ")
  Else
    getSYNONYMS = ""
  End If
End Function

Answer 1

You can get the image using something similar to the following:

    Sub Run()
getImage ("iron")
End Sub

Public Function getImage(ByVal name As String) As String
  Dim imgURL As String
  Dim XMLhttp: Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP")
  XMLhttp.setTimeouts 1000, 1000, 1000, 1000
  imgURL = "http://cactus.nci.nih.gov/chemical/structure/" + name + "/image"

  XMLhttp.Open "GET", imgURL, False
  XMLhttp.send

  If XMLhttp.Status = 200 Then
   'It exists so get the image
    Sheets(1).Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 250, 250
  Else
    '
  End If
End Function

I believe this could be further simplified to simply only use

Sheets(1).Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300

instead of downloading the image the twice, and simply using an error handler to catch when image not found.

Reference:

• Can I use VBA to import images (gifs) from the web into Excel?
• http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.shapes.addpicture.ASPX

Update:

Using the activesheet, and 300 pixels for width and height:

 ActiveSheet.Shapes.AddPicture imgURL, msoFalse, msoTrue, 100, 100, 300, 300